[bknr-cvs] r2200 - in branches/trunk-reorg/thirdparty: . slime slime/CVS slime/contrib slime/contrib/CVS slime/doc slime/doc/CVS

bknr at bknr.net bknr at bknr.net
Thu Oct 4 17:24:06 UTC 2007


Author: hhubner
Date: 2007-10-04 13:23:45 -0400 (Thu, 04 Oct 2007)
New Revision: 2200

Added:
   branches/trunk-reorg/thirdparty/slime/
   branches/trunk-reorg/thirdparty/slime/.cvsignore
   branches/trunk-reorg/thirdparty/slime/CVS/
   branches/trunk-reorg/thirdparty/slime/CVS/Entries
   branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log
   branches/trunk-reorg/thirdparty/slime/CVS/Repository
   branches/trunk-reorg/thirdparty/slime/CVS/Root
   branches/trunk-reorg/thirdparty/slime/CVS/Template
   branches/trunk-reorg/thirdparty/slime/ChangeLog
   branches/trunk-reorg/thirdparty/slime/HACKING
   branches/trunk-reorg/thirdparty/slime/NEWS
   branches/trunk-reorg/thirdparty/slime/PROBLEMS
   branches/trunk-reorg/thirdparty/slime/README
   branches/trunk-reorg/thirdparty/slime/contrib/
   branches/trunk-reorg/thirdparty/slime/contrib/CVS/
   branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries
   branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository
   branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root
   branches/trunk-reorg/thirdparty/slime/contrib/CVS/Template
   branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog
   branches/trunk-reorg/thirdparty/slime/contrib/README
   branches/trunk-reorg/thirdparty/slime/contrib/bridge.el
   branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el
   branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el
   branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp
   branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp
   branches/trunk-reorg/thirdparty/slime/doc/
   branches/trunk-reorg/thirdparty/slime/doc/.cvsignore
   branches/trunk-reorg/thirdparty/slime/doc/CVS/
   branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries
   branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository
   branches/trunk-reorg/thirdparty/slime/doc/CVS/Root
   branches/trunk-reorg/thirdparty/slime/doc/CVS/Template
   branches/trunk-reorg/thirdparty/slime/doc/Makefile
   branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.pdf
   branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex
   branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps
   branches/trunk-reorg/thirdparty/slime/doc/slime-small.pdf
   branches/trunk-reorg/thirdparty/slime/doc/slime.texi
   branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk
   branches/trunk-reorg/thirdparty/slime/hyperspec.el
   branches/trunk-reorg/thirdparty/slime/metering.lisp
   branches/trunk-reorg/thirdparty/slime/mkdist.sh
   branches/trunk-reorg/thirdparty/slime/nregex.lisp
   branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp
   branches/trunk-reorg/thirdparty/slime/slime-autoloads.el
   branches/trunk-reorg/thirdparty/slime/slime.el
   branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp
   branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp
   branches/trunk-reorg/thirdparty/slime/swank-backend.lisp
   branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp
   branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp
   branches/trunk-reorg/thirdparty/slime/swank-corman.lisp
   branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp
   branches/trunk-reorg/thirdparty/slime/swank-gray.lisp
   branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp
   branches/trunk-reorg/thirdparty/slime/swank-loader.lisp
   branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp
   branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp
   branches/trunk-reorg/thirdparty/slime/swank-scl.lisp
   branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp
   branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp
   branches/trunk-reorg/thirdparty/slime/swank.asd
   branches/trunk-reorg/thirdparty/slime/swank.lisp
   branches/trunk-reorg/thirdparty/slime/test-all.sh
   branches/trunk-reorg/thirdparty/slime/test.sh
   branches/trunk-reorg/thirdparty/slime/xref.lisp
Log:
update slime


Added: branches/trunk-reorg/thirdparty/slime/.cvsignore
===================================================================
--- branches/trunk-reorg/thirdparty/slime/.cvsignore	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/.cvsignore	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,6 @@
+*.x86f
+*.fasl
+*.dfsl
+*.lx64fsl
+*.elc
+_darcs

Added: branches/trunk-reorg/thirdparty/slime/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Entries	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Entries	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,34 @@
+/.cvsignore/1.5/Sun Apr  8 19:23:57 2007//
+/ChangeLog/1.1234/Thu Sep 27 12:56:13 2007//
+/HACKING/1.8/Wed Sep 19 11:08:27 2007//
+/NEWS/1.8/Sun Mar 27 19:41:17 2005//
+/PROBLEMS/1.8/Sun Nov 20 23:31:56 2005//
+/README/1.14/Tue Oct  3 21:49:13 2006//
+/hyperspec.el/1.11/Thu Dec  7 07:36:54 2006//
+/metering.lisp/1.4/Fri Apr  1 20:16:35 2005//
+/mkdist.sh/1.7/Mon Aug 29 20:02:58 2005//
+/nregex.lisp/1.4/Mon Sep 19 08:20:48 2005//
+/sbcl-pprint-patch.lisp/1.1/Fri Feb 17 01:30:21 2006//
+/slime-autoloads.el/1.3/Thu Sep 20 14:59:08 2007//
+/slime.el/1.875/Thu Sep 27 12:56:40 2007//
+/swank-abcl.lisp/1.43/Tue Sep  4 15:45:19 2007//
+/swank-allegro.lisp/1.98/Wed Sep 26 23:15:41 2007//
+/swank-backend.lisp/1.126/Mon Sep 10 15:39:05 2007//
+/swank-clisp.lisp/1.64/Thu Aug 23 19:03:37 2007//
+/swank-cmucl.lisp/1.174/Wed Sep  5 12:04:43 2007//
+/swank-corman.lisp/1.11/Thu Aug 23 19:03:37 2007//
+/swank-ecl.lisp/1.8/Thu May 17 11:49:40 2007//
+/swank-gray.lisp/1.10/Wed Apr 12 08:43:55 2006//
+/swank-lispworks.lisp/1.92/Thu Aug 23 19:03:37 2007//
+/swank-loader.lisp/1.73/Fri Sep 14 12:41:28 2007//
+/swank-openmcl.lisp/1.119/Thu Aug 23 19:03:37 2007//
+/swank-sbcl.lisp/1.185/Tue Sep 11 19:31:03 2007//
+/swank-scl.lisp/1.13/Thu Aug 23 19:03:37 2007//
+/swank-source-file-cache.lisp/1.8/Tue Dec  5 13:00:42 2006//
+/swank-source-path-parser.lisp/1.17/Sun Jun 25 08:33:16 2006//
+/swank.asd/1.5/Fri Sep 14 12:41:28 2007//
+/swank.lisp/1.511/Wed Sep 19 11:12:07 2007//
+/test-all.sh/1.2/Mon Aug 29 20:02:58 2005//
+/test.sh/1.9/Mon Aug 27 13:16:49 2007//
+/xref.lisp/1.2/Mon May 17 00:25:24 2004//
+D

Added: branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2 @@
+A D/contrib////
+A D/doc////

Added: branches/trunk-reorg/thirdparty/slime/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Repository	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Repository	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+slime

Added: branches/trunk-reorg/thirdparty/slime/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/slime/CVS/Root	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/CVS/Root	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+:pserver:anonymous:anonymous at common-lisp.net:/project/slime/cvsroot

Added: branches/trunk-reorg/thirdparty/slime/CVS/Template
===================================================================

Added: branches/trunk-reorg/thirdparty/slime/ChangeLog
===================================================================
--- branches/trunk-reorg/thirdparty/slime/ChangeLog	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/ChangeLog	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,13172 @@
+2007-09-27  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-filesystem-toplevel-directory): New function.
+	Windows doesn't have a filesystem that is as hierarchical as the
+	Unix' one. Reported by Carsten Blaauw and Stefan Kluehspies.
+	(slime-file-name-merge-source-root): Use it.
+	(slime-highlight-differences-in-dirname): Use it.
+
+2007-09-26  Utz-Uwe Haus  <haus+slime at mail.math.uni-magdeburg.de>
+
+	* swank-allegro.lisp (fspec-definition-locations): Allow the
+	POSITION datum of :top-level-form fspecs to be missing.  This
+	apparently helpful for Allegro CL 8.1.
+
+2007-09-21  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-length=, slime-length>): Restore support for
+	vectors, as `slime-length=' was already used with strings in
+	`slime-parse.el'. This broke extended arglist display.
+
+2007-09-20  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-setup): Call the respective init functions of
+	contribs.
+
+	* slime-autoloads.el (slime-setup-contribs): Ditto.
+
+2007-09-19  Helmut Eller  <heller at common-lisp.net>
+
+	Simplify slime-compile-file.
+
+	* slime.el (slime-compile-file): Don't save window config.
+	(slime-curry, slime-rcurry): New functions.
+
+	* slime.el (slime-complete-symbol*-fancy): Move defcustom to
+	contrib/slime-c-p-c.el
+
+	* swank-version.el: Delete file. No longer used.
+
+	* bridge.el: Moved to contrib.
+
+	* tree-widget.el: File deleted. Only needed by contribs and is
+	distributed with Emacs 21.
+
+	* slime.el: Reorder some devfars and menus code so that the
+	compiler doesn't complain about free variables.
+
+	Fix apropos in Emacs 22.
+
+	* slime.el (slime-print-apropos): Add button props for Emacs 22.
+	(slime-call-describer): ARG is a marker in Emacs 22.
+
+	(def-slime-selector-method ?c): Wait until slime-list-threads
+	returns.
+
+	Remove define-slime-dialect.
+
+	* slime.el (define-slime-dialect): Deleted. Use
+	slime-lisp-implementations instead.
+
+	Introduce a slime-start-and-init function.
+
+	* slime.el (slime-start-and-init, slime-lisp-options): New
+	functions.
+	(slime-start-and-load): Use it.
+
+	Simplify slime-length=.
+
+	* slime.el (slime-length=, slime-length>): No need for vectors.
+
+	Remove explicit support for Scheme mode.
+
+	* slime.el (slime-scheme-mode-hook, slime-shared-lisp-mode-hook)
+	Deleted.
+	(slime-indentation-update-hooks): New hook.
+	(slime-handle-indentation-update): Use it.
+
+	Fix close-connection.
+
+	* swank.lisp (close-connection): Use *log-output* instead of
+	*debug-io* (which could be redirected to the to-be-closed
+	connection).
+
+2007-09-15  Helmut Eller  <heller at common-lisp.net>
+
+	Let slime-setup load contribs.
+
+	* slime.el (slime-setup): Take a list of contribs to load as
+	argument.
+
+	* slime-autoloads.el (slime-setup): Ditto, but delay the actual
+	loading until slime is loaded.
+	(slime-setup-contribs): New function.
+
+2007-09-15  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-maybe-warn-for-different-source-root): Catch
+	returned NIL from `slime-file-name-merge-source-root' if the two
+	filenames don't share a common source root. 
+	Reported by Frank Goenninger.
+	
+2007-09-15  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-split-string): New semi-portability function.
+	The behaviour of `split-string' changed between Emacs21 and
+	Emacs22. Thanks to Christophe Rhodes for reporting this.
+	(slime-file-name-merge-source-root): Use `slime-split-string'.
+	(slime-highlight-differences-in-dirname): Likewise.
+
+2007-09-14  Helmut Eller  <heller at common-lisp.net>
+
+	Some cleanups for the REPL.
+
+	* slime.el (slime-repl-write-string): Split it up into smaller
+	functions.
+	(slime-repl-emit, slime-repl-emit-result)
+	(slime-emit-string): New functions.
+
+	(slime-repl-save-history): Use prin1 instead of pp.
+
+	(repl-type-ahead): New test case.
+
+2007-09-12  Christophe Rhodes  <csr21 at cantab.net>
+
+	Make ASDF:LOAD-OP (and SBCL REQUIRE) happy with swank.asd
+
+	* swank.asd: Define and use a CL-SCRIPT-FILE class for loading as
+	source, even with ASDF:LOAD-OP.
+
+2007-09-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-loader.lisp: Aways compile-file `contrib/swank-asdf.lisp'
+	on SBCL. This fixes "Undefined function" style-warnings when using
+	`slime-asdf' in combination with SBCL. Reported by Cyrus Harmon.
+
+	* swank-sbcl.lisp: Explicitly require ASDF. (While this is not
+	strictly necessary, as it's implicitly loaded on requiring the
+	other modules, I think it's better to be explicit about it.)
+
+2007-09-10  Helmut Eller  <heller at common-lisp.net>
+
+	Fix some bugs introduced while moving doc refs to contrib.
+
+	* swank-sbcl.lisp (condition-references): It's still needed.
+
+	* slime.el (sldb-dispatch-extras): Add missing quote.
+	(slime-sbcl-manual-root): Move definition to
+	contrib/slime-references.el.
+	(slime-cl-symbol-name, slime-cl-symbol-package): Move to
+	contrib/slime-parse.el.
+
+2007-09-10  Helmut Eller  <heller at common-lisp.net>
+
+	Move SBCL doc references to contrib.
+
+	* slime.el (sldb-insert-condition): Merge REFERENCES and EXTRAS.
+	(sldb-extras-hooks, sldb-dispatch-extras): New hook.
+
+	* swank-backend.lisp (condition-references): Removed. Merged with
+	condition-extras.
+
+	* swank-sbcl.lisp (condition-references): Removed.
+	(condition-extras): Include references.
+	(externalize-reference): New function.  Don't return plain
+	symbols.
+
+	* swank-allegro.lisp (condition-references): Removed.
+
+2007-09-10  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-cl-symbol-name, slime-cl-symbol-package):
+	Ressurected, as they're still used in this file. 
+	Reported by Edward Cant.
+
+2007-09-10  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	When working on multiple source trees simultaneously, the way
+	`slime-edit-definition' (M-.) works can sometimes be confusing:
+
+	`M-.' visits locations that are present in the current Lisp image,
+	which works perfectly well as long as the image reflects the
+	source tree that one is currently looking at.
+
+	In the other case, however, one can easily end up visiting a file
+	in a different source root directory (the one corresponding to the
+	Lisp image), and is thus easily tricked to modify the wrong source
+	files---which can lead to quite some stressfull cursing.
+
+	If the variable `slime-warn-when-possibly-tricked-by-M-.' is
+	T (the default), a warning message is issued to raise the user's
+	attention whenever `M-.' is about opening a file in a different
+	source root that also exists in the source root directory of the
+	user's _current buffer_.
+
+	There's no guarantee that all possible cases are covered, but if
+	you encounter such a warning, it's a strong indication that you
+	should check twice before modifying.
+	
+	* slime.el (slime-file-name-merge-source-root): New function.
+	(slime-highlight-differences-in-dirname): New function.
+	(slime-maybe-warn-for-different-source-root): New function.
+	(slime-warn-when-possibly-tricked-by-M-.): New variable (T by default.)
+	(slime-goto-location-buffer): Where appropriate, call
+	`slime-maybe-warn-for-different-source-root'
+	
+2007-09-08  Stelian Ionescu  <sionescu at common-lisp.net>
+
+	* slime.el (save-restriction-if-possible): Place macro definition
+	above use of the macro, to regain ability to byte-compile-file.
+
+2007-09-08  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Fix message displaying on XEmacs. Reported by Steven E. Harris,
+	and Ken Causey.
+
+	* slime.el (slime-display-message): Resurrect secondary
+	`buffer-name' argument which got lost in 2007-08-24.
+	(slime-format-display-message): Resurrect passing "*SLIME Note*"
+	as default buffer-name to `slime-display-message'.
+
+2007-09-08  Matt Pillsbury  <mtbp at rci.rutgers.edu>
+
+	* swank-backend.lisp (definterface): Updated docstring.
+
+2007-09-06  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-repl-write-string): Use case, not ecase, for
+	dispatching targets.Should fix XEmacs compatibility.
+	Reported by Steven E. Harris.
+
+2007-09-05  Didier Verna  <didier at xemacs.org>
+
+	* slime.el (slime-filename-translations): Fix custom type.
+
+2007-09-05  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-toggle-trace-fdefinition):  Fix typo.  The
+	 argument for interactive should be "P" not "p".
+
+2007-09-04  Mark Evenson  <mark.evenson at gmx.at>
+
+	* swank-abcl.lisp: Call accessors of compiler-condition at load
+	time to work around some ABCL problems.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Move asdf support to contrib.
+
+	* swank-backend.lisp (operate-on-system): Moved to
+	swank-asdf.lisp. It wasn't specialized in any backend.
+
+	* swank.lisp (operate-on-system-for-emacs)
+	(list-all-systems-known-to-asdf, list-asdf-systems): Moved to
+	swank-asdf.lisp.
+
+	* slime.el: Move asdf commands to contrib slime-adsf.el.
+
+	* swank-loader.lisp: Load swank-asdf if ASDF is in
+	*FEATURES*. Also add the contrib source directory to
+	swank::*load-path*.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Move tramp support to contrib.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Move startup animation to contrib.
+
+	* slime.el (slime-repl-banner-function): New hook.
+	(slime-repl-update-banner): Use it and reset markers after calling
+	it.
+	(slime-set-default-directory): Don't call slime-repl-update-banner
+	here.
+	(slime-repl-insert-prompt): Set slime-repl-input-end-mark to
+	point-max.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Move inferior-slime-mode to contrib.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Fix the test suite (except for SBCL).
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Simplify slime-process-available-input.
+
+	* slime.el (slime-process-available-input): We are called in a
+	process filter, i.e. at arbitrary times and in an aribtrary
+	buffer.  So it doesn't make sense to save-and-restore the current
+	buffer here
+	(slime-eval-async): Instead, save and restore the buffer here.
+	(slime-net-read-or-lose): New.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Remove request-abort condition.
+
+	* swank-backend.lisp (request-abort): Removed
+	(abort-request): Removed.  Replace all (3) uses with ERROR.
+	* swank.lisp (eval-for-emacs): No special case for request-abort.
+	* slime.el (slime-eval-async): Remove optional arg of :abort.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Rename slime-insert-possibly-as-rectangle to slime-insert-indented.
+
+	* slime.el (slime-insert-indented): Renamed. Update callers.
+
+2007-08-31  Helmut Eller  <heller at common-lisp.net>
+
+	Move compound prefix completion and autodoc to contrib.
+
+	* swank.lisp (simple-completions): Rewritten for simplicity.
+	(operator-arglist): Rewritten for simplicity.
+
+	* slime.el (slime-complete-symbol-function): Make simple
+	completion the default.
+	(slime-echo-arglist-function, slime-echo-arglist): New hook.
+
+	Remove corresponding key bindigs.
+
+	* slime.el (slime-obsolete-commands): New table. Use it to bind
+	a command with an upgrade notice.
+
+2007-08-31  Andreas Fuchs <asf at boinkor.net>
+
+	* slime.el (slime-reindent-defun): Fixed when used in lisp file
+	buffers. (Similiar patch also provided by Gábor Melis; problem
+	also reported by Jeff Cunningham.)
+
+2007-08-31  Jon Allen Boone <ipmonger at delamancha.org>
+
+	* swank-cmucl.lisp: CMUCL now has an x86-Darwin port as well as
+	  the PPC-Darwin version. Changed to conditionalize on the
+	  presence of darwin instead of ppc so that slime works with both
+	  Darwin versions of CMUCL.
+	
+2007-08-31  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-sexp-at-point): Explicitely set current syntax
+	table to operate in `lisp-mode-syntax-table' because
+	`thing-at-point' is used which depends on the syntax table. (E.g.
+	 keywords like `:foo' aren't recognized as sexp otherwise.)
+
+	* slime.el (slime-parse-extended-operator/declare): Wrap regexp
+	stuff in `save-match-data'
+	(slime-internal-scratch-buffer): Removed again. Was only
+	introduced as a performance hack; but it turned out that the bad
+	performance was because of unneccessary recursive calls of
+	`slime-make-form-spec-from-string'. (Which was fixed on 2007-08-27
+	already.)
+	(slime-make-form-spec-from-string): Use `with-temp-buffer' instead
+	of `slime-internal-scratch-buffer'. Removed activation of
+	`lisp-mode' in the temporary buffer, because this made
+	`lisp-mode-hooks' run. This activated autodoc in the temp buffer,
+	although the temp buffer is used to compute an autodoc
+	itself (which resulted in some very mutual recursion which caused
+	the current arglist to be displayed again and again---as could
+	have been witnessed in `*Messages*'.) `Lisp-mode' was activated to
+	get the right syntax-table for `slime-sexp-at-point', but this one
+	sets the correct syntax-table itself now.
+
+2007-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Fix user input type-ahead again (this change from 2007-08-25 got
+	lost).  Testcase: Type (dotimes (i 5) (format t "Number ~A~%"
+	i) (sleep 1)) and then type ahead while the command is executing
+	and output arrives.
+	
+	* slime.el (slime-repl-insert-prompt): Don't go to point-max but
+	to slime-repl-input-start-mark if there is one.  
+	(slime-repl-write-string): Insert a :repl-result before the
+	prompt, not at point-max.  Update markers properly.
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (safe-definition-finding): Remove whitespace
+	around error messages.
+	(trim-whitespace): New function.
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	Fix some output related bugs.
+
+	* swank.lisp (send-repl-results-to-emacs): Emit a fresh line.
+
+	* slime.el (slime-insert-transcript-delimiter): Use
+	insert-before-markers since slime-output-end is no longer left
+	inserting.  Reported by Austin Haas <austin at pettomato.com>.
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-display-or-scroll-completions,
+	slime-scroll-completions): New functions.  Factored out of
+	slime-expand-abbreviations-and-complete.
+
+2007-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-repl-write-string): Handle arbitrary targets
+	using slime-output-target-marker.
+	(slime-last-output-target-id, slime-output-target-to-marker)
+	(slime-output-target-marker)
+	(slime-redirect-trace-output): Move back here from slime-presentations.el.
+
+2007-08-28  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (classify-symbol, symbol-classification->string):
+	Resurrected in swank.lisp. (I was bitten by cvs-pcl which
+	committed (2007-08-27) my locally changed `contribs/swank-fuzzy.lisp'
+	where I already removed these functions from.)
+
+2007-08-28  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-make-form-spec-from-string): Elisp Hacking 101:
+	Don't use `beginning-of-buffer' and `end-of-buffer' in Elisp code.
+
+	* swank.lisp (read-form-spec): Unintern just newly interned
+	symbols when an reader error occurs.
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	Move presentations to contrib.  Part II.
+
+	* swank.lisp (*listener-eval-function*): New variables.
+	(listener-eval): Use it
+	(repl-eval): Used to be listener-eval.
+	(*send-repl-results-function*): New variable.
+	(eval-region): Simplify.
+	(track-package, cat): New functions.
+	(slime-repl-clear-buffer-hook): New hook.
+	(slime-repl-clear-buffer): Use it.
+
+2007-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Remove the ID argument from :write-string protocol messages.
+	Everything, except for rigid-indentation tricks, can be achieved
+	by using :write-string in conjunction with :presentation-start and
+	:presentation-end. 
+	
+	* swank.lisp (present-in-emacs): Unused, removed.
+	
+	* swank.lisp (make-output-function-for-target): Remove id argument
+	from :write-string.
+	(send-repl-results-to-emacs): Don't call
+	save-presented-object. Remove id argument from :write-string.
+
+	* slime.el (slime-dispatch-event): Change it here.
+	(slime-write-string, slime-repl-write-string): And here.
+
+2007-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-loader.lisp (*contribs*): Add swank-presentations.
+
+2007-08-27  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-make-extended-operator-parser/look-ahead): Move
+	to end of symbol at point.
+	(slime-make-form-spec-from-string): Fixes unexpected behaviour of
+	`save-excursion'.
+	
+2007-08-27  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-sexp-at-point): Fixes a few edge cases were
+	Emacs' `(thing-at-point 'sexp)' behaves suboptimally. For example,
+	`foo(bar baz)' where point is at the ?\(.
+	(slime-internal-scratch-buffer): New. This variable holds an
+	internal scratch buffer that can be reused instead of having to
+	create a new temporary buffer again and again.
+	(slime-make-extended-operator-parser/look-ahead): Uses
+	`slime-make-form-spec-from-string' to parse nested expressions
+	properly.
+	(slime-nesting-until-point): Added docstring.
+	(slime-make-form-spec-from-string): Added new optional parameter
+	for stripping the operator off the passed string representation of
+	a form. Necessary to work in the context of
+	`slime-make-extended-operator-parser/look-ahead'. Added safety check
+	against a possible endless recursion.
+
+	* swank.lisp (parse-form-spec): Looses restriction for nesting.
+	
+2007-08-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-eval-feature-conditional): Fix typo.
+	(slime-keywordify): Simplify.
+
+2007-08-27  Helmut Eller  <heller at common-lisp.net>
+
+	Move presentations to contrib.  Part I.
+
+	* slime.el (slime-event-hooks, slime-dispatch-event): New hook.
+	(slime-write-string-function, slime-write-string): New hook.
+	(slime-repl-return-hooks, slime-repl-return): New hook.
+	(slime-repl-current-input-hooks, slime-repl-current-input): New hook.
+	(slime-open-stream-hooks, slime-open-stream-to-lisp): New hook.
+	(sldb-insert-locals, slime-inspector-insert-ispec)
+	(slime-last-expression): Don't use presentations.
+
+2007-08-26  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Reduces needless interning of symbols that was introduced by my
+	recent work on autodoc to a minimum. Also fixes this issue for
+	`slime-complete-form' which always interned symbols even before my
+	changes.
+	
+	* slime.el (slime-sexp-at-point): If N is given, but there aren't
+	N sexps available at point, make it return a list of just as many
+	as there are.
+	(slime-make-form-spec-from-string): New. Creates a ``raw form
+	spec'' from a string that's suited for determining newly interned
+	symbols later in Swank.
+	(slime-parse-extended-operator/declare): Uses it.
+
+	* swank.lisp (parse-symbol): Returns internal knowledge, to
+	provide a means for callers to perform a sanity check.
+	(call-with-ignored-reader-errors): New. Abstracted out from
+	`read-incomplete-form-from-string.'
+
+	* swank.lisp (read-form-spec): New. Only READs elements of a form
+	spec if necessary. And if it does have to READ, it keeps track
+	of newly interned symbols which are returned as secondary
+	return value.
+	(parse-form-spec): Use it. Propagate newly interned symbols.
+	(parse-first-valid-form-spec): Likewise.
+	(arglist-for-echo-area, complete-form, completions-for-keyword):
+	Adapted to unintern the newly interned symbols.
+	
+
+2007-08-26  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (current-slime-narrowing-configuration):
+	Renamed to `slime-current-narrowing-configuration'.
+	(set-slime-narrowing-configuration):
+	Renamed to `slime-set-narrowing-configuration'.
+	(current-slime-emacs-snapshot):
+	Renamed to `slime-current-emacs-snapshot'.
+	(current-slime-emacs-snapshot-fingerprint):
+	Renamed to `slime-current-emacs-snapshot-fingerprint'.
+	(set-slime-emacs-snapshot):
+	Renamed to `slime-set-emacs-snapshot'.
+
+2007-08-26  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (save-restriction-if-possible): Fixed another typo,
+	duh! Thanks again to Matthias Koeppe.
+	
+2007-08-26  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-cl-symbol-name): Handle vertical bars (|)
+	(%slime-nesting-until-point): Renamed to `slime-nesting-until-point'.
+	
+2007-08-25  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Fix a bug where REPL results would sometimes be indented by a
+	random amount.  
+	
+	* slime.el (slime-insert-presentation): Make the
+	rectangle-ification of multi-line presentations, introduced
+	2006-12-19, optional.
+	(slime-write-string): Use it here only for regular output, but not
+	for REPL results.
+	(sldb-insert-locals): Use it here.
+	(slime-inspector-insert-ispec): Use it here.
+
+2007-08-25  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Fix handling of user-input type-ahead in the REPL.
+	Reported by Madhu <enometh at meer.net> on 2007-04-24.
+	
+	* slime.el (slime-write-string): Make sure text properties are
+	rear-nonsticky, so typed-ahead user input does not pick up the
+	text properties.  Fix up some markers.
+	(slime-reset-repl-markers): Make the marker slime-output-end of
+	insertion type nil (no automatic advances on insertions).
+	(slime-with-output-end-mark): Update the location of
+	slime-output-end here manually.
+	(slime-repl-update-banner): Use insert-before-markers.
+
+2007-08-25  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	New command slime-redirect-trace-output creates a separate Emacs
+	buffer, where all subsequent trace output is sent.
+	
+	* slime.el (slime-last-output-target-id): New variable.
+	(slime-output-target-to-marker): New variable.
+	(slime-output-target-marker): New function.
+	(slime-write-string): Handle general "target" arguments using
+	slime-output-target-marker. 
+	(slime-redirect-trace-output): New command.
+	(slime-easy-menu): Add a menu item for it.
+
+	* slime.el (slime-mark-presentation-start)
+	(slime-mark-presentation-end): Make "target" argument optional.
+	Use slime-output-target-to-marker.
+	
+	* swank.lisp (make-output-stream-for-target): New function, 
+	factored out from open-streams.
+	(open-streams): Use it here.
+
+	* swank.lisp (connection): New slot "trace-output".
+	(call-with-redirected-io): Use it here.
+	(redirect-trace-output): New slimefun; set the slot to a new
+	target stream.
+
+2007-08-25  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (save-restriction-if-possible): Fixed typo in
+	macroexpansion. Thanks to Matthias Koeppe for reporting.
+
+2007-08-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-insert-arglist): Removed, superseded by
+	slime-complete-form since 2005-02-20.
+
+	* swank.lisp (arglist-for-insertion): Now unused, removed.
+
+2007-08-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Some fixes to the presentation-streams contrib.
+	
+	* slime.el (slime-dispatch-event): Handle new optionals args of
+	messages :presentation-start and :presentation-end.
+
+	* slime.el (slime-mark-presentation-start)
+	(slime-mark-presentation-end): New arg "target"; record
+	presentation boundaries separately for REPL results and regular
+	process output.  This fixes the presentation markup of REPL
+	results when the presentation-streams contrib is loaded.
+	
+2007-08-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Make the fancy presentation-streams feature a contrib.
+	Previously, it was only available if "present.lisp" was loaded
+	manually.  Now it can be loaded automatically using:
+
+	   (add-hook 'slime-load-hook 
+	             (lambda () (require 'slime-presentation-streams)))
+
+	Note that the normal presentations that are created by REPL
+	results, the inspector, and the debugger are NOT dependent on this
+	code.
+	
+	* present.lisp: Moved to contrib/swank-presentation-streams.lisp.
+	* swank-loader.lisp (*contribs*): Add swank-presentation-streams.
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	Move typeout frame to contrib.
+
+	* slime.el (slime-message-function, slime-background-message-function)
+	(slime-autodoc-message-function): New variables.
+	(slime-message, slime-background-message)
+	(slime-autodoc-message): Call the function in the respective
+	variable, so that the typeout window can be plugged in.
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	Move xref and class browser to contrib.
+
+	* slime.el (slime-browse-classes, slime-browse-xrefs): Gone. The
+	Common Lisp part is still there.
+
+2007-08-24  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-forward-blanks): Wrapped w/ `ignore-errors.'
+	(slime-sexp-at-point): Return results as a list of strings, rather
+	than just one big string if called with arg > 1.
+	(slime-parse-extended-operator-name): Wrapping some movement code
+	in `ignore-errors'. Adapted to new return value of
+	`slime-enclosing-form-specs'. Minor cosmetic changes.
+	(slime-make-extended-operator-parser/look-ahead): Adapted to
+	changes of the ``raw form spec'' format; returns a form of
+	strings, instead of a string of a form.
+	(slime-parse-extended-operator/declare): Simplified. Adapted to
+	changes of the ``raw form spec'' format; passes decl-identifiers,
+	or typespec-operators respectively, along the decl/type-spec.
+	(%slime-in-mid-of-typespec-p): Removed. Replaced by an regexp
+	based approach.
+	(%slime-nesting-until-point): New helper for
+	`slime-parse-extended-operator/declare'.
+
+	* swank.lisp (parse-form-spec): Adapted to new ``raw form spec''
+	format. Updated format description in docstring accordingly.  The
+	new format allows less interning of wrong symbols names comming
+	from Slime. Thanks to Matthias Koeppe for spotting this.
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	Move slime-highlight-edits-mode to contrib.
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	Move slime-scratch to contrib.
+
+	* slime.el (slime-scratch): Gone.
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	Various cleanups related to slime-insert-propertized.
+
+	* slime.el (slime-with-rigid-indentation): Fix evaluation order.
+	(slime-indent-rigidly): New.
+	(slime-insert-possibly-as-rectange): Don't set mark.
+	(slime-insert-propertized): Use plain insert instead of
+	slime-insert-possibly-as-rectange.
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (sbcl-inspector): Fix typo.
+
+2007-08-23  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Repair inspection of presentations.
+
+	* swank.lisp (inspect-presentation): New slimefun.
+	* slime.el (slime-inspect-presentation-at-mouse): Use it here.
+
+2007-08-23  Helmut Eller  <heller at common-lisp.net>
+
+	Move Marco Baringer's inspector to contrib.
+
+	* swank.lisp (*default-inspector*): New variable. Set this
+	variable dispatch to different inspectors.
+	(inspect-object): Use it.
+
+	* swank-loader.lisp (*contribs*): Add 'swank-fancy-inspector.
+
+	* swank-backend.lisp (backend-inspector): New class.  Introduce a
+	named class to give as another way to dispatch to backend methods.
+
+	* swank-cmucl.lisp: Use backend-inspector class.
+	* swank-sbcl.lisp: Use backend-inspector class.
+	* swank-clisp.lisp: Use backend-inspector class.
+	* swank-lispworks.lisp: Use backend-inspector class.
+	* swank-allegro.lisp: Use backend-inspector class.
+	* swank-openmcl.lisp: Use backend-inspector class.
+	* swank-abcl.lisp: Use backend-inspector class.
+	* swank-corman.lisp: Use backend-inspector class.
+	* swank-scl.lisp: Use backend-inspector class.
+
+2007-08-23  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Added arglist display for declaration specifiers and type
+	specifiers.
+
+	Examples:
+
+	`(declare (type' will display
+
+	   (declare (type type-specifier &rest vars))
+
+	`(declare (type (float' will display
+
+	   [Typespec] (float &optional lower-limit upper-limit)
+
+	`(declare (optimize' will display
+
+	   (declare (optimize &any (safety 1) (space 1) (speed 1) ...))
+
+	&ANY is a new lambda keyword that is introduced for arglist
+	description purpose, and is very similiar to &KEY, but isn't based
+	upon plists; they're more based upon *FEATURES* lists. (See the
+	comment near the ARGLIST defstruct in `swank.lisp'.)
+
+	* slime.el:
+	(slime-to-feature-keyword): Renamed to `slime-keywordify'.
+	(slime-eval-feature-conditional): Adapted to use `slime-keywordify'.
+	(slime-ensure-list): New utility.
+	(slime-sexp-at-point): Now takes an argument that specify how many
+	sexps at point should be returned.
+	(slime-enclosing-operator-names): Renamed to
+	`slime-enclosing-form-specs'.
+	(slime-enclosing-form-specs): Returns a list of ``raw form specs''
+	instead of what was called ``extended operator names'' before, see
+	`swank::parse-form-spec' for more information. This is a
+	simplified superset. Additionally as tertiary return value return
+	a list of points to let the caller see where each form spec is
+	located. Adapted callers accordingly. Extended docstring.
+	(slime-parse-extended-operator-name): Adapted to changes in
+	`slime-enclosing-form-specs'. Now gets more context, and is such
+	more powerful. This was needed to allow parsing DECLARE forms.
+	(slime-make-extended-operator-parser/look-ahead): Because the
+	protocol for arglist display was simplified, it was possible to
+	replace the plethora of parsing function just by this one.
+	(slime-extended-operator-name-parser-alist): Use it. Also add
+	parser for DECLARE forms.
+	(slime-parse-extended-operator/declare): Responsible for parsing
+	DECLARE forms.
+	(%slime-in-mid-of-typespec-p): Helper function for
+	`slime-parse-extended-operator/declare'.
+	(slime-incomplete-form-at-point): New. Return the ``raw form
+	spec'' near point.
+	(slime-complete-form): Use `slime-incomplete-form-at-point'.
+
+	* swank.lisp: New Helper functions.
+	(length=, ensure-list, recursively-empty-p): New.
+	(maybecall, exactly-one-p): New.
+
+	* swank.lisp (arglist-for-echo-area): Adapted to take ``raw form
+	specs'' from Slime.
+	(parse-form-spec): New. Takes a ``raw form spec'' and returns a
+	``form spec'' for further processing in Swank. Docstring documents
+	these two terms.
+	(split-form-spec): New. Return relevant information from a form	spec.
+	(parse-first-valid-form-spec): Replaces `find-valid-operator-name'.
+	(find-valid-operator-name): Removed.
+	(operator-designator-to-form): Removed. Obsoleted by `parse-form-spec'.
+
+	(defstruct arglist): Add `any-p' and `any-args' slots to contain
+	arguments belonging to the &ANY lambda keyword.
+	(print-arglist): Adapted to also print &ANY args.
+	(print-decoded-arglist-as-template): Likewise.
+	(decode-arglist): Adapted to also decode &ANY args.
+	(remove-actual-args): Adapted to also remove &ANY args.
+	(remove-&key-args): Split out from `remove-actual-args'.
+	(remove-&any-args): New. Removes already provided &ANY args.
+	(arglist-from-form-spec): New. Added detailed docstring.
+	(arglist-dispatch): Dispatching generic function for
+	`arglist-from-form-spec' that does all the work. Renamed from
+	prior `form-completion'.
+	(arglist-dispatch) Added methods for dealing with declaration and
+	type-specifiers.
+	(complete-form): Adapted to take ``raw form specs'' from Slime.
+	(completions-for-keyword): Likewise.
+	(format-arglist-for-echo-area): Removed. Not needed anymore.
+
+	* swank-backend.lisp (declaration-arglist): New generic
+	function. Returns the arglist for a given declaration
+	identifier. (Backends are supposed to specialize it if they can
+	provide additional information.)
+	(type-specifier-arglist): New generic function. Returns the
+	arglist for a given type-specifier operator. (Backends are
+	supposed to specialize it if they can provide additional
+	information.)
+	(*type-specifier-arglists*): New variable. Contains the arglists
+	for the type specifiers in Common Lisp.
+
+	* swank-sbcl.lisp: Now depends upon sb-cltl2.
+	(declaration-arglist 'optimize): Specialize the `optimize'
+	declaration identifier to pass it to
+	sb-cltl2:declaration-information.
+	
+	
+2007-08-23  Helmut Eller  <heller at common-lisp.net>
+
+	Some inspector cleanups.
+
+	* slime.el (slime-inspect): Remove dwim stuff and drop keyword
+	args.
+	(slime-read-object): Killed.
+	(slime-open-inspector): Drop keyword args.  Update callers
+	accodordingly, expect presentation related code. Presentations no
+	longer work in the inspector.
+
+	* swank.lisp (*inspector-dwim-lookup-hooks*)
+	(default-dwim-inspector-lookup-hook): Deleted.
+	(init-inspector): Sanitize arglist.
+	(inspect-object): Don't return an :id for *inspectee-parts*.
+
+	* swank-backend (type-for-emacs): Removed. No backend implemented
+	it.
+
+2007-08-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-fuzzy-upgrade-notice): New function.  Bound to
+	the key where slime-fuzzy-complete-symbol used to be.
+
+2007-08-22  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-close-all-parens-in-sexp): Fix interplay with
+	`slime-close-parens-limit'. This should also affect
+	`slime-complete-form' (C-c C-s) in a positive way.
+
+2007-08-19  Helmut Eller  <heller at common-lisp.net>
+
+	* contrib: New directory.  Move fuzzy completion code to that
+	directory.
+
+	* swank.lisp (swank-require): New function to load contrib code.
+	(*find-module*, module-filename, *load-path*, merged-directory)
+	(find-module, module-canditates): New. Pathname acrobatics for
+	swank-require.
+
+	* swank-loader.lisp: Compile (but don't load) contribs.
+	(*contribs*, contrib-source-files): New.
+
+2007-08-16  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-process-available-input): Correct yesterday's
+	change: the buffer a request was originally performed in doesn't
+	necessarily exist at this time anymore, so we check for buffer
+	liveness now.
+
+	 The problem arised when quitting in SLDB which would cause Swank
+	 to send a `:debug-return' message before the acknowledgement
+	 message for `sldb-quit' is sent. So the acknowledgement is
+	 received in a context where the sldb-buffer is closed already.
+
+2007-08-15  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-process-available-input): Make sure that the
+	event received from SWANK is processed in the context of the
+	original buffer the request of the response was performed in.
+	Previously, the clauses of `slime-rex' were processed in the
+	internal *cl-connection* buffer. And as a result the continuations
+	passed to `slime-eval' and `slime-eval-async' ditto.
+
+2007-08-15  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Make `M-.' work on definitions outside the current restriction.
+	`M-,' will also properly restore the narrowing as of before the
+	jump. Similiarly for quiting from the compilation notes buffer and
+	the Xref buffers.
+
+	* slime.el (slime-narrowing-configuration, slime-emacs-snapshot),
+        (current-slime-narrowing-configuration),
+        (set-slime-narrowing-configuration),
+	(current-slime-emacs-snapshot),
+	(set-slime-emacs-snapshot),
+	(current-slime-emacs-snapshot-fingerprint): New. Emacs' window
+	configurations do not restore narrowing, so introduce a
+	snapshot facility that contains the necessary information.
+
+	* slime.el: Various renaming and adaptions in the Slime temp
+	buffer, xref, goto-definition and compilation notes section to use
+	the newly introduced snapshots instead of mere window
+	configurations.
+
+	* slime.el: (slime-highlight-notes, slime-remove-old-overlays):
+	Still operate on whole buffer, but restore previous restriction if
+	there was any.
+        (slime-goto-location-position): Now widens the buffer to properly
+	jump to definitions outside of the current restriction.
+
+	* slime.el (slime-push-definition-stack),
+	(slime-pop-find-definition-stack): Now also stores information
+	about narrowing on the definition stack, in order to properly
+	restore narrowing on `M-,'.
+
+	* slime.el (def-slime-test narrowing): Test case for properly
+	dealing with narrowing.
+
+	* slime.el (slime-buffer-narrowed-p): New function, tests whether
+	the current buffer is narrowed or not.
+	(save-restriction-if-possibly): Like `save-restriction', but not
+	as strict---see doc string.
+	
+	* slime.el (slime-length=): New function; semantically the same
+	as (= (length seq) n), but more efficiently implemented for lists.
+	Changed the above pattern into a call to SLIME-LENGTH= where
+	appropriate.
+	
+2007-08-05  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (backtrace): Handle printer errors while printing a
+	frame.  This makes debugging print-object methods with SLIME
+	easier.  Reported by Utz-Uwe Haus.
+
+2007-08-02  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime.el (slime-kill-all-buffers): Now also kills all buffers
+	beginning with a `*SLIME' prefix (like, for instance, `*SLIME
+	Apropos*', or `*SLIME macroexpansion*'.)
+	
+2007-06-28  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (def-slime-selector-method): Revert Marco's change from
+	2007-05-23.  BODY can return a buffer name, like "*slime-events*".
+	Handle that and never ignore invalid return values.  Force BODY to
+	abort if there's no suitable buffer.  Why would you want to switch
+	buffers if the desired buffer doesn't exist?
+
+2007-06-27  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Fixing `C-c M-q' at the REPL. Thanks to André Thieme for pointing
+	out that it has been broken since several months.
+	
+	* slime.el (slime-reindent-defun): Use functions
+	`slime-beginning-of-defun' and `slime-end-of-defun' that were
+	introduced in the last changeset. 
+	
+2007-06-16  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el: Pressing `C-M-a' (beginning-of-defun) in midst of the
+	last REPL prompt directs the cursor to the beginning of the
+	prompt. Pressing it again, would do nothing; now it moves the
+	cursor to the start of the previous prompt (as it's consistent
+	with the behaviour when the cursor was placed midst one of the old
+	prompts.)
+
+	Likewise for `C-M-e' (end-of-defun)
+
+	Additionally fixing `C-c C-s' (slime-complete-form) at the REPL.
+
+	(slime-keys): New bindings for `C-M-a' and `C-M-e' to
+	SLIME-BEGINNING-OF-DEFUN and SLIME-END-OF-DEFUN respectively.
+	(slime-keys): Making `C-c C-q' (slime-close-parens-at-point)
+	obsolete, as it didn't work correctly on the REPL.
+	(slime-repl-mode-map): Removed bindings for `C-M-a' and `C-M-e',
+	as they're now inherited from SLIME-KEYS.
+	(slime-repl-beginning-of-defun, slime-repl-end-of-defun): Jump to
+	the previous (next) prompt if called twice in a row.
+
+	(slime-close-parens-at-point): Commented out.
+	(slime-close-all-sexp): Renamed to SLIME-CLOSE-ALL-PARENS-IN-SEXP.
+	(slime-close-all-parens-in-sexp): Modified to take
+	SLIME-CLOSE-PARENS-LIMIT into account.
+	(slime-complete-form): Use SLIME-CLOSE-ALL-PARENS-IN-SEXP.
+	
+
+2007-05-24  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Fixed regression in completion: "swank[TAB]" would
+	previously be completed to "swank-backend:"; "get-internal[TAB]"
+	would be completed to "get-internal-r-time" (instead of simply
+	"get-internal-r"); and "custom:*comp[TAB]" would be completed to
+	"custom:*compiled-" on CLISP, even though there's a
+	"custom:*complile-". 
+
+	Thanks to Ken Causey for helping me find the first two.
+
+	(completions): Revert changes from 2007-05-11.
+	(longest-compound-prefix): Fixed to properly generate a compound
+	_prefix_.
+	
+2007-05-23  Marco Baringer  <mb at bese.it>
+
+	* slime.el (def-slime-selector-method): Allow the selector body to
+	not return a buffer. This means that, instead of being to forced
+	to signal an error when a choosen buffer can't be found (like
+	choosing d when there are no debugger buffers) can simply display
+	a message.
+ 
+	Fix handling of auto-flushing on sbcl:
+	
+	* swank-sbcl.lisp (*auto-flush-interval*): New variable
+	controlling how often streams are flushed.
+	(*auto-flush-lock*): New lock guarding access to the shared
+	variable *auto-flush-streams*.
+	(make-stream-interactive): Wrapped access to *auto-flush-streams*
+	in a call-with-recursive-lock-held.
+	(flush-streams): Wrapped in call-with-recursive-lock-held.
+	
+2007-05-17  Martin Simmons <martin at lispworks.com>
+
+	* swank-lispworks.lisp (lispworks-inspect): Fix hanging caused by
+	mapcan, i.e. nconc, on a constant list returned by
+	label-value-line.
+
+2007-05-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-complete-form): Only insert a closing
+	parenthesis if the form is not already closed. Reported by and
+	adapted from Mac Chan.
+	
+2007-05-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Fixed bug in completion as previously "swank:[tab]"
+	would correctly list all the symbols in SWANK, but would
+	simultaneously append a spooky dash to the original
+	string ("swank:-").
+
+	(completions): Strip off the package identifier part, and only
+	compute the longest compound prefix for the actual symbol
+	identifiers.
+	(untokenize-symbol): New function. Inverse of TOKENIZE-SYMBOL.
+	(format-completion-result): Use UNTOKENIZE-SYMBOL.
+	
+2007-05-17  Dustin Long <dlong at stevens.edu>
+
+	* swank-ecl.lisp (compile-from-stream): Fixed typo that prevented
+	`slime-compile-defun' from actually compiling a function.
+
+2007-05-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-loader.lisp (*sysdep-files*): Load the auxiliary files
+	swank-source-*.lisp before swank-sbcl.lisp to avoid
+	undefined-function style warnings.
+	
+2007-05-16  Takehiko Abe <keke at gol.com>
+
+	* swank.lisp (inspect-for-emacs file-stream, stream-error): Fixed
+	typo in keyword arg; it's `:refreshp', not `:refresh'.
+
+2007-05-14  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el: Fixed proper handling of the abortion of a
+	request. (For instance, when calling (SWANK::ABORT-REQUEST "FOO")
+	from the REPL.)
+
+	(sldb-quit): Updated the DESTRUCTURE-CASE clause for (:abort) to
+	take an argument.
+	(sldb-continue): Likewise.
+	(sldb-invoke-restart): Likewise.
+	(sldb-break-with-default-debugger): Likewise.
+	(sldb-return-from-frame): Likewise.
+	(sldb-restart-frame): Likewise.
+	(slime-repl-eval-string) Likewise.
+	(slime-repl-show-abort): Now also inserts the reason for the abort
+	into the REPL buffer.
+	
+	* swank.lisp (eval-for-emacs): Remove code that would suggest that
+	it's possible to use the rex `(:abort ...)' with more than one
+	argument.
+
+2007-05-14  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Liberated from unnecessary style-warnings!
+
+	(eval-for-emacs): Don't use SLOT-VALUE on condition objects!
+	(inspect-bigger-piece-actions): Changed from DEFMETHOD to DEFUN.
+	(inspect-whole-thing-action): Likewise.
+	(inspect-show-more-action): Likewise.
+	(make-symbols-listing): Adds an explicit DEFGENERIC.
+	(menu-choices-for-presentation): Likewise.
+
+	(make-symbols-listing (eql :classification)): Use `(loop for k
+	being EACH hash-key ...)' rather than `(loop for k being THE
+	hash-key)', to omit the justified style-warning from CLISP.
+	
+2007-05-14  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (package-names): Make sure to return a fresh list.
+	(fuzzy-find-matching-packages): Use PACKAGE-NAMES.
+	(list-all-package-names): Use PACKAGE-NAMES.
+	
+2007-05-13  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-pretty-lambdas): Removed. If you really want
+	this, please use one of the external ressources that provide this;
+	for instance, `pretty-lambda.el', `pretty-greek.el', or even
+	`pretty-symbols.el'. For more information, please see
+
+	   http://www.emacswiki.org/cgi-bin/wiki/PrettyLambda
+	
+2007-05-11  Tobias C. Rittweiler <tcr at freebits.de>
+	
+	* swank.lisp (fuzzy-find-matching-symbols): Modified to take
+	package nicknames into account. Previously, fuzzy completing on
+	nicknames did (except for some incidental cases) not work. Thanks
+	to Luís Oliveira and Attila Lendvai for pointing that out.
+
+2007-05-11  Tobias C. Rittweiler <tcr at freebits.de>
+
+	Removed support for completing to the longest compound pre- and
+	suffix with the default completion method (C-c TAB, or just TAB on
+	the REPL), because it has been causing trouble all the time, but
+	didn't offer any real advantage besides niftiness. E.g.:
+
+	    previous behaviour: 
+
+	      asdf:*com TAB => asdf:*compile-file--behaviour*
+
+	    now simply:
+
+	      asdf:*com TAB => asdf:*compile-file-
+
+	For discussing on this subject, please see the mail with
+	message-id <87y7l53lch.fsf at freebits.de> that was posted to
+	slime-devel 2007-04-06, or alternatively:
+
+	http://common-lisp.net/pipermail/slime-devel/2007-April/006087.html
+
+	* swank.lisp (make-compound-prefix-matcher): New function.
+	Abstracted from COMPOUND-PREFIX-MATCH.
+	(compound-prefix-match): Use MAKE-COMPOUND-PREFIX-MATCHER.
+	(compound-prefix-match/ci/underscores): Removed.
+
+	(longest-completion): Renamed to LONGEST-COMPOUND-PREFIX. Changed
+	to only return a compound prefix, instead of a concatenation of a
+	compound prefix and a compound suffix. Added an &optional
+	parameter to specify what delimeter the passed string is
+	compounded with.
+	(tokenize-completion): Takes additional parameter to specify the
+	delimeter for tokenization.
+	(longest-completion/underscores): Removed; not needed anymore.
+	(tokenize-completion/underscores): Likewise.
+	(untokenize-completion/underscores): Likewise.
+
+	(completions): Slight docstring modification, also added an
+	examplary use case; use LONGEST-COMPOUND-PREFIX instead of
+	LONGEST-COMPLETION.
+	(completions-for-character): Use LONGEST-COMPOUND-PREFIX, and
+	MAKE-COMPOUND-PREFIX-MATCHER.
+	(completions-for-keyword): Use LONGEST-COMPOUND-PREFIX.
+	
+2007-05-11  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (apropos-symbols): Really use MAKE-REGEXP-MATCHER.
+
+2007-05-10  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Previously when using SLIME-APROPOS-PACKAGE, only
+	those symbols were considered whose home package matched the
+	given package; this would, however, prevent all those symbols from
+	being listed that are imported from another package, and then
+	exported again in the package they got imported into. (As an
+	example, SWANK:RESTART-FRAME is actually from SWANK-BACKEND.)
+
+	(apropos-matcher): Renamed to MAKE-REGEXP-MATCHER.
+	(make-regexp-matcher): Changed to only match for a given regexp.
+	(apropos-symbols): Use MAKE-REGEXP-MATCHER.
+
+2007-05-10  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el: Fix macroexpanding on things like ",(loop ...)".
+
+	(slime-sexp-at-point-for-macroexpansion): New function; like
+	SLIME-SEXP-AT-POINT-OR-ERROR, but fixes up some misbehaviour with
+	respect to macroexpansion.
+	(slime-eval-macroexpand, slime-eval-macroexpand-inplace): Use the
+	new function.
+
+2007-05-10  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el: Within the Slime Inspector, `S-Tab' will now also work
+	 on X.  Furthermore `Tab' and `S-Tab' will now correctly wrap
+	 around the beginning and end of the buffer; priorly it'd hang on
+	 the beginning with a message "Beginning of buffer", and would
+	 require an additional `S-Tab'.
+
+	(slime-inspector-mode-map): Attached `[backtab]' to
+	SLIME-INSPECTOR-PREVIOUS-INSPECTABLE-OBJECT, as Emacs translates
+	`S-Tab' to `Backtab' on X.
+	(slime-find-inspectable-object): New function; finds next or
+	previous inspectable object.
+	(slime-inspector-next-inspectable-object): Mostly rewritten. Use
+	SLIME-FIND-INSPECTABLE-OBJECT to make the code clearer.
+
+2007-04-19  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-backend.lisp (label-value-line): Add :newline as &key
+	argument; if true (the default) inserts a newline.
+
+	* swank.lisp (inspect-for-emacs-list): Don't add a newline after
+	the last value of the list.
+	
+2007-04-18  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (log-event): Setup the printer so that, no matter
+	what the global values of the *print-XYZ* variables, this function
+	works as expected.
+	(*debug-on-swank-error*): New variable.
+	(defpackage :swank): Export *debug-on-swank-error*.
+	(with-reader-error-handler): When *debug-on-swank-error* is
+	non-nil drop into a debugger.
+	(dispatch-loop): Idem.
+
+2007-04-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Instead of just having all the symbols of a package
+	listed alphabetically in the inspector page recently introduced
+	for that purpose, add a button to that page to group them by their
+	classification.
+
+	(%package-symbols-container): New slot GROUPING-KIND.
+	(%make-package-symbols-container): New function; wraps around
+	%%MAKE-PACKAGE-SYMBOLS-CONTAINER, which will actually create the
+	structure. We need this, to make GROUPING-KIND an entirely
+	internal affair.
+
+	(make-symbols-listing): New generic function to dispatch on
+	GROUPING-KIND.
+	(make-symbols-listing :symbol): Just the stuff that was priorly
+	wired into INSPECT-FOR-EMACS (%PACKAGE-SYMBOLS-CONTAINER).
+	(make-symbols-listing :classification): New; returns the passed
+	symbols grouped by their classification.
+	(inspect-for-emacs %package-symbols-container): Most code split
+	off into MAKE-SYMBOLS-LISTING.
+
+2007-04-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (swank-compiler): Fix the return value to always be a
+	list of two elements even if the abort restart is invoked which
+	originally just returned NIL. (Which wouldn't play with the recent
+	change to use DESTRUCTURING-BIND in SLIME-COMPILATION-FINISHED.)
+
+2007-04-17  Tobias C. Rittweiler <tcr at freebits.de>
+
+ 	* swank.lisp (inspect-for-emacs %package-symbols-container):
+	Revert Marco's change from 2007-04-08; he had the good idea of
+	adding a facility to jump to the relevant source line of a symbol,
+	but `M-.' is already bound to SLIME-FIND-DEFINITION in the
+	inspector, which is a nicer way of doing this alltogether.
+	
+2007-04-16  Takehiko Abe <keke at gol.com>
+
+	* swank-openmcl.lisp (accept-connection, find-external-format):
+	utf-8 support.
+
+2007-04-16  Marco Baringer <mb at bese.it>
+
+	* slime.el (slime-with-xref-buffer): Added missing ,
+
+2007-04-16  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el: Pressing `q' in *compiler notes* after a `C-c C-k' or
+	`C-c M-k' would not probably restore the original window
+	configuration. Fix that.
+
+	(slime-get-temp-buffer-create): New &key arg WINDOW-CONFIGURATION.
+	(slime-with-xref-buffer): Likewise.
+	
+	(slime-compilation-finished): New &optional arg WINDOW-CONFIG.
+	(slime-maybe-show-xrefs-for-notes): Likewise.
+	(slime-show-xrefs) Likewise.
+	(slime-maybe-list-compiler-notes): Likewise.
+	(slime-list-compiler-notes): Likewise.
+
+	(slime-compilation-finished-continuation): Renamed to
+	SLIME-MAKE-COMPILATION-FINISHED-CONTINUATION.
+
+	(slime-make-compilation-finished-continuation): Now takes two
+	args, the current buffer and optionally the current window config
+	to be restored.
+	
+	(slime-compile-file): Save current window configuration before
+	popping up the REPL for compilation output, pass it down.
+	(slime-easy-menu): Add entry for SLIME-UNTRACE-ALL.
+
+2007-04-16  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (fuzzy-find-matching-packages): Fix a small typo that
+	prevented interpreting NIL as the argument TIME-LIMIT-IN-MEC to
+	mean an infinite time limit. This bug propagated up to explicit
+	calls to FUZZY-COMPLETIONS, like 
+	   (swank:fuzzy-completions "mvb" "COMMON-LISP") => (NIL, T)
+
+	(format-fuzzy-completions): Renamed to FORMAT-FUZZY-COMPLETION-SET
+	
+	(format-fuzzy-completion-set): Accomodated to recent changes of
+	the return value of FUZZY-COMPLETIONS; changed the docstring to
+	make it explicit that this function is supposed to take the return
+	value of FUZZY-COMPLETION-SET.
+
+	* slime.el (slime-compilation-finished): Don't use
+	MULTIPLE-VALUE-BIND for list destructuring, only because multiple
+	values happen to be implemented via lists in elisp!
+	(slime-fuzzy-completions-mode): Added an detailed explanation to
+	the docstring of how Fuzzy Completion works and how it'ss supposed
+	to be worked with.
+	(slime-fuzzy-explanation): Shortened to reference to
+	SLIME-FUZZY-COMPLETIONS-MODE for help on fuzzy completion.
+	(slime-fuzzy-choices-buffer): Set BUFFER-QUIT-FUNCTION to
+	SLIME-FUZZY-ABORT to make it correctly exit fuzzy completion when
+	pressing `Esc Esc Esc' (`M-Esc Esc').
+
+2007-04-12  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp (emacs-buffer-source-location): Add &allow-other-keys
+	to the descructuring of the source location plist in order to accept
+	:emacs-directory.
+
+2007-04-09  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (inspector-content-for-emacs): Look for refresh
+	keyword argument in :action links.
+	(inspect-whole-thing-action, inspect-show-more-action): Update for
+	new :action argument handling.
+	(inspect-for-emacs stream, inspect-for-emacs stream-error): Pass
+	:refresh nil on :action links.
+	(action-part-for-emacs): Set both lambda and refresh in the
+	*inspectee-actions* array.
+	(inspector-call-nth-action): *inspectee-actions* now holds both
+	the function and the boolean specifying whether to refresh or not.
+
+	* swank-backend.lisp (inspect-for-emacs): Docstring update.
+
+	* slime.el (slime-inspector-operate-on-point): Allow the action
+	calls to return nil.
+
+2007-04-08  Marco Baringer  <mb at bese.it>
+	
+	* .cvsignore: Added *.lx64fsl (openmcl on linux fasls).
+
+2007-04-08  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (inspect-for-emacs): Added 'jump to source' action
+	for symbols in the new package-symbol browser.
+
+2007-04-08  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Implemented a new special inspector page for
+	displaying internal (external, &c) symbols that display
+	classification flags additionally to each symbol, similiar to the
+	content of a *Fuzzy Completion* buffer.  Furthermore, added the
+	possibility to display all symbols that are /present/ in a
+	package. Combined with cleanup of the code parts in question.
+
+	(symbol-status): New function. Returns the status of a symbol in a
+	given package (:internal, :external &c.)
+
+	(symbol-external-p): Adapted to use new function SYMBOL-STATUS.
+
+	(symbol-classification->string): New function. Converts a list of
+	classification flags into a concise string representation.
+
+	(%package-symbols-container): New struct. We need a unique type to
+	dispatch in INSPECT-FOR-EMACS for the new inspector page, use this
+	as a wrapper structure.
+
+	(inspect-for-emacs package): Reorganized to not cause too much eye
+	cancer; now with a saner maximum column width. Changed to make use
+	of new SYMBOL-STATUS, for code reuse. Also changed to make use of
+	new %PACKAGE-SYMBOLS-CONTAINER to let a new page pop up in Emacs
+	if the user wants to access the list of symbols of the package.
+	Added such a possibility to access all `present' symbols.
+	
+	(inspect-for-emacs %package-symbols-container): New method.
+	Displays all symbols wrapped up in the container structure
+	combined with their classification flags as determined by
+	CLASSIFY-SYMBOL.
+	
+2007-04-08  Luís Oliveira <loliveira at common-lisp.net>
+
+	* swank-backend.lisp (compute-sane-restarts): New interface.
+	* swank-clisp.lisp: Fix tabs and trailing whitespace.
+	(compute-sane-restarts): Implement new interface.
+
+2007-04-08 Takehiko Abe <keke at gol.com>
+
+	* swank-openmcl.lisp (xref-locations):
+
+2007-04-08  Marco Baringer <mb at bese.it>
+
+	* swank.lisp (fuzzy-completion-set): Use two check-type forms
+	instead of a place like (values limit time-limit-in-msec). While
+	sbcl seems to accept this form openmcl doesn't and it's not clear
+	from the spec that this is allowed.
+	
+2007-04-07 Harald Hanche-Olsen <hanche at math.ntnu.no>
+
+	* slime.el (sldb-mode-map): Added key definition for follow-link.
+
+2007-04-06  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Making fuzzy completion regard the time limit
+	correctly. Also make it properly use microseconds as time
+	granularity and inform the Emacs side if the time limit has
+	exhausted. Additionally, over all minor and cosmetic changes:
+
+	(fuzzy-completions, fuzzy-completion-set): Returns now
+	additionally a flag indicating whether the time limit has
+	exhausted under the hood. Accomodated docstring accordingly.
+
+	(fuzzy-create-completion-set): Changed to correctly catch and
+	propagate the remaining time limit to the actual match functions,
+	and return once time limit has exhausted. Some aesthetical code 
+	reorganization.
+
+	(get-real-time-in-msecs): New function. 
+
+	(fuzzy-find-matching-symbols, fuzzy-find-matching-packages):
+	Correctly regard the time limit. Use new function
+	GET-REAL-TIME-IN-MSECS for that purpose. Return the remaining
+	time limit as second value.
+
+	* slime.el (slime-fuzzy-complete-symbol): Accomodated to deal with
+	the additionally returned flag of SWANK:FUZZY-COMPLETIONS. Pass
+	the flag by.
+	(slime-fuzzy-choices-buffer): Pass interruption flag by.
+	(slime-fuzzy-fill-completions-buffer): If time limit has exhausted
+	during completion retrieval, show an informational indication as
+	last entry in *Fuzzy Completion*.
+	(slime-fuzzy-last): New variable. To hold the last real completion
+	choice previous to the (possible) Time Limit Exhausted information.
+	(slime-fuzzy-next): Accomodated to not go beneath SLIME-FUZZY-LAST.
+	
+2007-04-06  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp (tokenize-symbol, tokenize-symbol-thoroughly):
+	Previously these functions said a string representing a symbol is
+	internal exactly if it contained "::" as substring. Now they say
+	additionally so for symbols without any package identifier, as
+	they are internal to am implicit current package. (Otherwise
+	will break fuzzy completion.)
+
+	(tokenize-symbol): Added docstring.
+
+	* swank.lisp (format-completion-result): Fixed formation
+	for the case that PACKAGE-NAME is NIL but INTERNAL-P is T.
+
+2007-04-06  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Making fuzzy completion semantically right from a
+	user perspective. As an example on SBCL, "sb:with- C-c M-i" will
+	display all exported "with"-style macros in all sb-* packages from
+	now on. :)
+
+	(parse-completion-arguments): Replacing with a semantically-sound
+	implementation, as the previous one was a bit confused. Clarifying
+	docstring. Adding commentary table of various constellations of
+	returned values for thorough explanation.
+
+	(carefully-find-package): Removed. Obsolete by above change.
+
+	(defstruct fuzzy-matching): Introduced to make internally-used
+	datastructure explicit. Distinguishing ``completion chunks''
+	between those pertaining to the symbol itself and those to the
+	package identifier.
+
+	(convert-fuzzy-completion-result): Renamed to
+	FUZZY-CONVERT-MATCHING-FOR-EMACS.
+
+	(fuzzy-convert-matching-for-emacs): Accomodating for the new
+	datastructure. Only the chunks pertaining to the symbol itself are
+	fixed up positionally, the package-chunks are untouched.
+	Necessary for letting package identifiers be highlighted within
+	*Fuzzy Completions* in cases like "sb:with- C-c M-i."
+
+	(fuzzy-completion-set): Taking out most code to become new
+	function FUZZY-CREATE-COMPLETION-SET.
+
+	(fuzzy-create-completion-set): Doing all the hard work. Crux of
+	this changeset. so to speak. Largly rewritten to accomodate all
+	different cases of PARSE-COMPLETION-ARGUMENT.
+
+	(fuzzy-find-matching-symbols, fuzzy-find-matching-packages):
+	Accomodating to new datatstructure FUZZY-MATCHING. Adapting
+	docstring accordingly.
+
+	* swank-backend.lisp: Export WITH-STRUCT.
+	
+	* swank.lisp (eval-for-emacs, fuzzy-completions): 
+	Various trivia like fixing spelling and indentation.
+
+2007-04-06  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-fuzzy-highlight-current-completion): Fix
+	off-by-one error that causes the currently selected 
+	completion in the *Fuzzy Completion* buffer be highlighted
+	one char too far.
+	
+2007-04-06  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank.lisp: Cleanup of parts of the fuzzy completion code.
+	Additionally a couple of enhancements. As follows:
+	
+	(fuzzy-completions, fuzzy-completion-selected): Minor 
+	stylistic and clarifying modifications of the docstrings.
+
+	(fuzzy-find-matching-symbols): Huge code reorganization.
+	Organizing relevant code into local function TIME-EXHAUSTED-P,
+	renaming local function SYMBOL-MATCH to PERFORM-FUZZY-MATCH,
+	making previously required argument EXTERNAL to new &key
+	argument :EXTERNAL-ONLY, clarifying docstring.
+
+	(fuzzy-find-matching-packages): Making its return value
+	conformant to that of FUZZY-FIND-MATCHING-SYMBOLS, i.e.
+	instead of returning, among others, a package's name as
+	string, it now returns a symbol representing the package.
+	Accomodates the docstring accordingly. 
+
+	(fuzzy-completion-set): Minor typographical fix in docstring.
+	Changing local function CONVERT to use MAP-INTO instead of
+	doing it essentially manually. Accomodating to changes of
+	FUZZY-FIND-MATCHING-SYMBOLS, resp. -PACKAGES.
+
+	(fuzzy-completion-set):	Additional new feature: 
+	The returned completions are sorted alphabetically by the
+	matched completion string before sorted by its score. 
+	Affects especially the list of all possible completions when 
+	the user hits fuzzy-completion on an empty string within Emacs;
+	also makes the potential limitness of the listed completions
+	clearer to the end user of SLIME.
+
+	(classify-symbol): New function. Returns a list with keywords
+	that classifies a given symbol. (E.g. :BOUNDP, :MACRO &c)
+	Supersedes parts of CONVERT-FUZZY-COMPLETION-RESULT, 
+	implementing them in a more straightforward and proper way;
+	removes prior KLUDGE in that part of the original function.
+
+	(convert-fuzzy-completion-result): The above changes made
+	it possible to simplify this function drastically. Now uses
+	the newly introduced function CLASSIFY-SYMBOL.
+
+	* slime.el: Minor stylistic changes. Additionally:
+	(slime-fuzzy-insert-completion-choice): 
+	(slime-fuzzy-fill-completions-buffer) : Adding use of the 
+	:PACKAGE classification flag returned by SWANK:FUZZY-COMPLETIONS.
+	This flag is called "p".
+
+2007-04-06  Neil Van Dyke  <neil at neilvandyke.org>
+
+	* slime.el (sldb-insert-frame): Added mouse-face to frame label
+	and expression in Backtrace.
+	(sldb-insert-frames): Added mouse-face to "--more--" label in
+	Backtrace.
+
+2007-04-06 Michael Weber <michaelw+slime at foldr.org>
+
+	* slime.el (slime-call-defun): insert the closing parenthesis for
+	the form.
+	
+2007-04-06  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (package swank-mop): Added
+	slot-makunbound-using-class.
+
+2007-03-29  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp (swank-compile-string): save the original
+	directory into the source plist as :emacs-directory.
+	(make-definition-source-location): use the :emacs-directory from
+	the source plist and guess-readtable-for-filename to determine the
+	correct readtable for string-compiled definitions.
+
+2007-03-29  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank.lisp (*macroexpand-printer-bindings*): add *print-lines*
+	to defaults (NIL).
+	(find-definitions-for-emacs): use unless instead of cond.
+
+2007-03-25  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* slime.el (with-selected-window): define for compatibility with
+	Emacs 21.
+
+2007-03-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (menu-choices-for-presentation): Offer a
+	"disassemble" menu item for functions.
+
+2007-03-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-read-port-and-connect): Fix race condition:
+	retry one more time if the port file is empty. Pop up the debugger
+	on other errors.
+	(slime-attempt-connection): Moved to toplevel.
+	(slime-timer-call): New. Used by slime-attempt-connection.
+	(slime-cancel-connect-retry-timer): New.
+	(slime-abort-connection): Use it.
+	(slime-repl-insert-prompt): Use insert-before-markers. This fixes
+	some redisplay problems, but I don't know why.  Also: remove the
+	timer for async output.
+	(slime-repl-move-output-mark-before-prompt): Removed.
+	(slime-repl-save-merged-history): Use with-temp-message.
+	(slime-goto-location-buffer): Support Zip files.
+	(sldb-quit): Don't print "Evaluation aborted".
+
+2007-03-22  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-scratch-buffer): Respect the syntax text
+	properties of presentations. 
+
+2007-03-21  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (lookup-presented-object): The presentation id of
+	frame locals now includes the thread id; ignore it for now.
+
+	* slime.el (slime-copy-presentation-at-mouse-to-point): Manually
+	invoke the after-change function, so that the presentation overlay
+	is created even if we paste to non-REPL buffers.
+	(slime-menu-choices-for-presentation): Evaluate
+	menu-choices-for-presentation-id in the right buffer, thus in the
+	right Lisp thread.  Reported by Attila Lendvai.
+	(slime-menu-choices-for-presentation): Show the id of the presentation.
+	(sldb-insert-locals): Include the thread id in the presentation id.
+
+2007-03-21  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-eval-string, slime-repl-insert-result):
+	Support the presentation-less old protocol.
+	(slime-goto-location-position): Use column number if available.
+
+2007-03-20  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (completion-output-symbol-converter): Fix completion
+	for mixed-case symbols that need escaping in readtable-case
+	:upcase or :downcase.
+
+	* slime.el (slime-copy-presentation-at-mouse-to-point) 
+	(slime-copy-presentation-at-mouse-to-kill-ring): New commands.
+	(slime-menu-choices-for-presentation): Change interface.  New
+	menu options, Copy to kill-ring, Copy to point.
+	(slime-presentation-menu): Change call to
+	slime-menu-choices-for-presentation. 
+
+2007-03-20  Takehiko Abe  <keke at gol.com>
+
+	* swank-openmcl.lisp (hash-table-weakness): fix typo
+
+2007-03-14  Christophe Rhodes  <csr21 at cantab.net>
+
+	* slime.el (slime-search-suppressed-forms): handle multiple
+	conditionals on the same line.
+
+2007-02-26  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank.lisp (inspect-for-emacs): Add support for inspecting
+	non-decodable float entities like NaNs and infinities.
+
+2007-02-25  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-backend.lisp (inspect-for-emacs): Remove reference to
+	inexistent argument from docstring.
+
+2007-02-25  Harald Hanche-Olsen <hanche at math.ntnu.no>
+
+	* slime.el (slime-init-keymaps): Use vectors when defining keys,
+	because e.g. (define-key (string ?\C-c) ...) doesn't work in the
+	emacs-unicode-2 branch.  Some strings are still there.
+
+2007-02-25  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-delete-swank-port-file): Don't use
+	display-warning; that's not available everywhere.
+	(slime-repl-update-banner): Insert the date only if the buffer is
+	empty.
+	(slime-list-compiler-notes): Fetch the notes only if called
+	interactively.
+	(slime-set-query-on-exit-flag): New function, to avoid compiler
+	warnings about obsolete function process-kill-without-query.
+	(slime-defun-if-undefined): Perform the test at runtime not at
+	compile time.  Reported by Lennart Staflin.
+	
+	* swank.lisp (guess-package): Renamed from
+	guess-package-from-string.
+	(set-package): Use it.
+
+2007-02-22  Juho Snellman  <jsnell at iki.fi>
+
+	* slime.el (slime-start-lisp): Don't cd if no directory was specified.
+	(slime-maybe-start-lisp): Pass directory argument to slime-start-lisp
+	also in other cond branch.
+	(slime-restart-sentinel): Pass a NIL directory to slime-start-lisp.
+
+2007-02-21  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-start): Added :directory argument and pass it to
+	slime-maybe-start-lisp.
+	(slime-maybe-start-lisp): Added directory argument and pass it to
+	slime-start-lisp (but not slime-reinitialize-inferior-lisp-p)
+	(slime-start-lisp): Added directory argument. Used to set buffer's
+	directory before starting the inferior lisp.
+
+2007-02-17  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-find-tag-if-tags-table-visited): New function.
+	(slime-edit-definition-fallback-function): Offer it as a value
+	for customization.
+
+2007-02-05  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (sldb-insert-locals): Repair presentation markup of
+	frame locals.
+
+2007-02-04  Antonio Menezes Leitao <aml at gia.ist.utl.pt>
+
+	* swank-lispworks.lisp (dspec-file-position): Bind
+	*compile-file-pathname*, *compile-file-truename*, *load-pathname*
+	and *load-truename* in dspec-file-position.
+
+2007-02-04  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-write-string): When writing a :repl-result,
+	update the slime-output-end marker for the purpose of asynchronous
+	output (when *use-dedicated-output-stream* is true). 
+	Reported by Madhu <enometh at meer.net>.
+
+2007-02-03  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-delete-swank-port-file): Fix typo in
+	warning message.
+
+2007-02-02  Marco Baringer  <mb at bese.it>
+
+	Warn, as opposed to bailing out with an error, when deleting the
+	port file fails. Patch by: Samium Gromoff
+	<_deepfire at feelingofgreen.ru>
+	
+	* slime.el (slime-delete-swank-port-file): New function.
+	(slime-inferior-connect): Use slime-delete-swank-port-file.
+	(slime-read-port-and-connect): Use slime-delete-swank-port-file.
+ 
+2007-01-31  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-repl-update-banner): Restore animation.
+	(slime-startup-animation): restore.
+
+2007-01-30  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-complete-symbol-function): Restore old default.
+	(set-keymap-parents): Deleted.
+	(slime-startup-animation): Deleted.
+	(slime-read-from-minibuffer): Don't use defun*.
+	(slime-repl-terminate-history-search): New.
+	(slime-repl-next-matching-input): Use it.
+
+	* slime-autoloads.el: New file.
+	
+2007-01-29  Sean O'Rourke <sorourke at cs.ucsd.edu>
+
+	* slime.el (slime-start): Continue even if the user, after
+	prompting, didn't recompile the stale .elc file.
+	(slime-urge-bytecode-recompile) [xemacs]: Abort immediately if the
+	user doesn't want to continue.
+	(slime-recompile-bytecode): Don't use byte-compile-warning-types;
+	it may not exist in XEmacs.
+	
+2007-01-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (sldb-recenter-region): Use count-screen-lines instead
+	of count-lines.
+
+	* swank.lisp (unparse-name): New function.
+	(list-all-package-names): Use it.  This fixes a bug related to
+	readtable-case and makes package name completions look prettier.
+	Suggested by Harald Hanche-Olsen <hanche at math.ntnu.no>.
+
+2007-01-24  Bill Clementson <billclem at gmail.com>
+
+	* slime.el (slime-call-defun): Put the docstring before
+	the (interactive) form so that "C-h f slime-call-defun" will
+	return it.
+
+	* slime.el (slime-scratch-mode-map): Changed parent keymap to
+	lisp-mode-map to prevent unnecessary duplication of slime-mode-map
+	bindings and so that lisp-mode-map key bindings are present in the
+	slime scratch buffer. Change identified by Ariel Badichi.
+ 
+2007-01-20  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime): Use COMMAND and CODING-SYSTEM parameters
+	Previously they were ignored.
+
+2007-01-17  Christian Lynbech <christian.lynbech at ericsson.com>
+
+	* slime.el (slime-init-command): Use expanded files when writing
+	the LOAD form for swank.
+
+2007-01-14  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Cleanups for the repl history code.
+	(slime-repl-mode-map): Don't shadow M-C-d.
+	(slime-repl-history-replace): Simplified.
+	(slime-repl-history-search-in-progress-p): New.
+	(slime-repl-position-in-history): If there's no match return
+	out-of-bound positions instead of nil.
+	(slime-repl-add-to-input-history): Never modify the argument.
+	(slime-repl-previous-input): Renamed from
+	slime-repl-previous-input-starting-with-current-input.
+	(slime-repl-next-input): Renamed from
+	slime-repl-next-input-starting-with-current-input
+	(slime-repl-forward-input): Renamed from slime-repl-next-input.
+	(slime-repl-backward-input): Renamed from
+	slime-repl-previous-input.
+	(slime-repl-history-pattern): Renamed from
+	slime-repl-matching-input-regexp.
+	(slime-repl-delete-from-input-history): Simplified.
+
+	(slime-repl-history-map)
+	(slime-repl-history-navigation-neutral-commands)
+	(slime-repl-jump-to-history-item)
+	(slime-repl-previous-or-next-input)
+	(slime-repl-starting-with-current-input-regexp)
+	(slime-repl-continue-search-with-last-pattern)
+	(slime-repl-previous-or-next-matching-input): Deleted.
+
+	(sldb-list-locals, sldb-list-catch-tags): Deleted. Aren't of much
+	use anymore.
+
+2007-01-12  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-clisp.lisp: Better classification on frames on the stack.
+	Make variables in eval frames accessible to the debugger.
+	(frame-type, *frame-prefixes*, frame-to-string, is-prefix-p)
+	(frame-string-type, boring-frame-p): New.
+	(%frame-count-vars, %frame-var-name, %frame-var-value)
+	(frame-venv, next-venv, venv-ref, %parse-stack-values): Replaces 
+	old frame-do-venv.
+	(extract-frame-line, extract-function-name, split-frame-string)
+	(string-match): New code to print frames.
+	(frame-locals, frame-var-value): Use the new stuff.
+
+	(inspect-for-emacs): Fix various bugs.
+
+	* swank-loader.lisp (compile-files-if-needed-serially): Don't wrap
+	everything in a compilation unit.  If we abort on load errors and
+	it is confusing to see compiler warnings after the abort message.
+	(handle-loadtime-error): CLISP's format implements ~< differently
+	as everybody else, so use a explicit pprint-logical-block instead.
+
+	* swank.lisp (list-all-systems-in-central-registry): Don't
+	reference asdf directly, that leads to read errors in some
+	systems.
+
+2007-01-12  Juho Snellman  <jsnell at iki.fi>
+
+	* slime.el (slime-read-expression-map): Switch the slime-mode-map
+	and minibuffer-local-map back the way they were. The previous change
+	was made due to a misunderstanding, caused by a keybinding for
+	[(return)] apparently being more specific than one for (kbd "RET"),
+	even when the former is in a parent keymap and the latter in the
+	child.
+	
+2007-01-12  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (handle-request): Use 'abort as restart name, but
+	bind *sldb-quit-restart* to the restart returned by find-restart.
+	Also use a slighly friendlier message, because newbies seem to
+	invoke the ABORT restart instead of pressing q in the debugger.
+	
+2007-01-12  Edi Weitz  <edi at agharta.de>
+
+	* slime.el (slime-find-asd): Remove file extension.
+
+	(slime-read-system-name): Use SWANK:LIST-ASDF-SYSTEMS.
+
+	* swank.lisp (list-all-systems-in-central-registry): Use only
+	pathname name.
+
+	(list-all-systems-known-to-asdf): New function.
+
+	(list-asdf-systems): New function.
+
+2007-01-12  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-keys): Remove binding of M-*, restore binding of
+	M-,.
+
+2007-01-11  Edi Weitz  <edi at agharta.de>
+
+	* slime.el (slime-repl-test-system, slime-repl-test/force-system):
+	New REPL shortcuts.  Patch by Kevin Rosenberg
+	<kevin at rosenberg.net>.
+
+2007-01-11  Juho Snellman  <jsnell at iki.fi>
+
+	* slime.el (slime-read-expression-map): restore tab completion in
+	the minibuffer. Switch the slime-mode-map and minibuffer-local-map
+	around, so that the minibuffer binding for return takes precedence
+	over the slime-mode one.
+	
+2007-01-11  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (inspect-for-emacs integer): Don't die if the integer
+	can't be expressed as a float.  Patch by Ariel Badichi
+	<abadichi at bezeqint.net>.
+ 
+	* slime.el (slime-keys): Removed binding of M-,
+	
+2007-01-11  Helmut Eller  <heller at common-lisp.net>
+	
+	* slime.el: Some cleanups for the debugger code: add some outline
+	sections and docstrings.
+	
+	(sldb-setup): Always display the beginning of the condition
+	text. Previously, we always showed the beginning of the backtrace.
+
+	(sldb-prune-initial-frames): Do what the docstring says. Reverted
+	to Luke's version.
+
+	(sldb-dispatch-extras): Fix typo.
+
+	(sldb-insert-restarts, sldb-insert-frames)
+	(sldb-insert-frame, sldb-fetch-more-frames)
+	(sldb-toggle-details, sldb-show-frame-details)
+	(sldb-insert-locals): Simplified.
+	(sldb-frame-details): New.
+
+	(slime-save-coordinates, slime-coordinates)
+	(slime-restore-coordinate, slime-count-lines): New macro and its
+	helpers.
+	(sldb-recenter-region): Renamed from slime-maybe-recenter-region.
+	
+	(sldb-enable-styled-backtrace, sldb-show-catch-tags)
+	(sldb-highlight): Deleted. Seem to be obsolete.
+	(sldb-add-face): Removed, because it is now the same as
+	slime-add-face.
+
+	(sldb-help-summary): Deleted. The docstring for sldb-mode is
+	already pretty terse.
+	(define-sldb-face): Renamed from def-sldb-face.
+
+	* swank-sbcl.lisp, swank-cmucl.lisp (condition-extras): Fix typo
+	
+2007-01-10  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*sldb-printer-bindings*): Add *print-right-margin*.
+	(debug-in-emacs): Bind *sldb-printer-bindings* here ...
+	(backtrace, debugger-info-for-emacs, frame-locals-for-emacs): 
+	... and remove redundant bindings here.
+
+2007-01-10  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el: FIX: set-keymap-parents for GNU Emacs was bogus, fixed
+	by Ariel Badichi.
+
+2007-01-09  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-merge-histories): Use (setf (gethash ...)
+	instead of puthash, for Emacs 20.
+
+2007-01-09  Juho Snellman  <jsnell at iki.fi>
+
+	SBCL 1.0.1.15 supports restart-frame natively, and uses a different
+	debug catch tag interface than earlier versions.
+	
+	* swank-sbcl (sbcl-with-restart-frame): New function, detects SBCL
+	1.0.1.15 or later.
+	(return-from-frame): Another version for 1.0.1.15, using
+	sb-debug:unwind-to-frame-and-call
+	(restart-frame): Another version for 1.0.1.15, using
+	sb-debug:unwind-to-frame-and-call
+	
+2007-01-07  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (open-streams): Don't pass nil to make-fn-streams;
+	use a dummy function as workaround.  Both arguments must be
+	functions and CMUCL checks the types.
+
+2007-01-06  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el: Added set-keymap-parents when not available (GNU
+	Emacs). Result: slime bindings while reading expressions from the
+	minibuffer.
+
+	* slime.el, swank.lisp: FIX: slime-insert-possibly-as-rectange and
+	sldb stuff on newer emacsen
+
+2007-01-04  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el: Added slime-insert-possibly-as-rectangle and use it
+	when inserting things here and there. The effect of this is that
+	multi-line strings coming from swank (e.g. stuff in sldb) are
+	inserted with insert-rectangle, so they are properly indented.
+
+	* swank.lisp: FIX: sort is destructive, call copy-seq at a few
+	places. FIX: bind *sldb-printer-bindings* also in
+	frame-locals-for-emacs.
+
+2007-01-03  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* swank.lisp: FIX: drop extra "Slots: " from standard-object's
+	inspector presentation
+
+	* swank.lisp: FIX: keyword symbols keep their : when travelling
+	from swank to slime
+
+	* slime.el: FIX: older Emacsen have no line-number-at-pos.
+
+	* slime.el: Convert some minibuffer reading defun's to defun* and
+	use keywords. Support extra arguments.
+
+	* slime.el: Use set-parent-keymaps when available (xemacs only for
+	now) when setting up slime-read-expression-map. The effect of this
+	is that the minibuffer will have all the slime-mode-map keys where
+	minibuffer-local-map is not overriding.
+
+	* slime.el, swank.lisp: Handle better the case when swank can not
+	read anything from the string sent to be inspected. Only bring up
+	the debugger when the inspect command is prefixed.
+
+2006-12-31  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Restore the nested-presentations feature.
+	
+	* present.lisp (slime-stream-p): Allow sending presentations to
+	the repl-results stream.
+	(make-presentations-result): Removed.
+	(send-repl-results-to-emacs): New.
+
+	* swank.lisp (connection): New slot repl-results (a stream).
+	(make-output-function-for-target): New.
+	(open-streams): Use it here to also create a stream for REPL results.
+	(initialize-streams-for-connection): Store the stream.
+
+2006-12-29  Edi Weitz  <edi at agharta.de>
+
+	* slime.el (slime-find-asd, slime-read-system-name): Only offer
+	initial input if system is really in central registry.
+
+2006-12-29  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Simplify the REPL-results protocol.  The results are now printed
+	using special :WRITE-STRING events from the Lisp side. 
+	
+	* slime.el (slime-repl-insert-prompt): Don't insert a result, only
+	the prompt.
+	(slime-repl-insert-result): Removed.
+	(slime-repl-eval-string, slime-repl-show-abort) 
+	(slime-repl-set-package, slime-output-buffer)
+	(slime-repl-update-banner): Change all callers.
+	(slime-dispatch-event): Event :WRITE-STRING gets an
+	optional argument TARGET, which controls where the string is
+	inserted.
+	(slime-write-string): Handle targets NIL (regular process output)
+	and :REPL-RESULT. 
+
+	* swank.lisp (make-presentations-result): Removed.
+	(send-repl-results-to-emacs): New function, sends :WRITE-STRING events.
+	(listener-eval): Use it here instead of make-presentations-result.
+
+2006-12-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Performance improvement for slime-autodoc-mode, in particular when
+	there are REPL results that are long lists.
+	
+	* slime.el (slime-repl-mode-beginning-of-defun)
+	(slime-repl-mode-end-of-defun): New.
+	(slime-repl-mode): Use them as beginning-of-defun-function and
+	end-of-defun-function.
+	(slime-enclosing-operator-names): Bind
+	parse-sexp-lookup-properties to nil, don't parse more than 20000
+	characters before point, don't determine exact argument positions
+	larger than 64.  Byte-compile this function.
+
+2006-12-24  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el, swank.lisp: Added customizable dwim lookup hook
+	support for inspect
+
+	* doc/slime.texi: Small doc fixes by Alfredo Beaumont
+
+	* swank.lisp: Change the order to [set value] [make unbound]. Sort
+	slot names in the inspector
+
+2006-12-23  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-clisp.lisp (make-weak-key-hash-table)
+	(make-weak-value-hash-table): Implement for CLISP, so that the
+	REPL results history does not cause "memory leaks".
+
+	* slime.el (slime-inspect): Add a dwim-mode keyword argument, move
+	all input handling into the interactive spec.  Restore the
+	behavior of slime-inspect when point is within a presentation (no
+	prompting, no DWIM).
+	(slime-inspect-presentation-at-mouse): Don't do DWIM here, so the
+	presentation-retrieval expression does not end up on the inspector
+	stack. 
+	(slime-inspector-position): New.
+	(slime-inspector-operate-on-point, slime-inspector-reinspect): Use
+	it here to make it work on GNU Emacs too.
+	(slime-open-inspector): Fix row-col addressing at end of buffer.
+
+2006-12-20  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el: FIX: inspecting presentations from the right click
+	menu broke in the inspect refactor
+
+	* slime.el: FIX: slime-fuzzy-target-buffer-completions-mode's
+	keymap must always precede other keymaps
+
+	* slime.el, swank.lisp: Extend :write-string with and &optional
+	presentation id and use this in present-in-emacs
+
+	* swank.lisp: Added present-in-emacs that prints a presentation of
+	the given object in the repl
+
+	* swank.lisp: Return the inspected object when inspecting from the
+	lisp side.
+
+	* swank.lisp: Turn off right margin for restart printing, too
+
+2006-12-19  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* HACKING: Added useful init.el piece into HACKING about
+	update-change-log
+
+	* swank.lisp: In all-slots-for-inspector pad slot names to be
+	equal length, so the result is more readable
+
+	* slime.el: Fix slime-insert-presentation to handle multi-line
+	presentations better (use insert-rectangle)
+
+	* swank.lisp: Properly bind *sldb-printer-bindings* and turn off
+	right margin while printing stuff in sldb
+
+	* slime.el: Smarten up the sldb heuristic that drops swank frames
+
+	* swank-allegro.lisp, swank-backend.lisp, swank-openmcl.lisp,
+	swank-sbcl.lisp, swank.lisp: Added hash-table-weakness and use it
+	in hash-table-inspecting
+
+	* swank.lisp: Hashtable inspecting: added [clear hashtable]
+	and [remove entry] actions
+
+	* slime.el, swank.lisp: FIX dwim inspecting to handle (setf
+	some-fun) functions, too
+
+	* slime.el: FIX: slime-sexp-at-point for foo::|bar::baz|
+
+	* slime.el: FIX: Properly keep track of slime-buffer-package in
+	the inspector
+
+	* swank.lisp: Small: get rid of notes and warnings
+
+	* slime.el, swank.lisp: Added dwim-mode to slime-inspect that
+	tries to be smart unless prefixed
+
+	* slime.el: Make slime-fuzzy-complete-symbol the default in the
+	belife that it's better for new users
+
+	* swank.lisp: Add (expt 1.2 length) higher scores for longer
+	matches in fuzzy completion. A good example: puts "make-instance"
+	before "make-string-input-stream" while completing "make-ins"
+
+	* slime.el: Set slime-fuzzy-completion-in-place enabled by default
+
+	* slime.el: Added (cons row col) addressing to
+	slime-open-inspector, use in slime-inspector-operate-on-point
+
+	* slime.el: FIX: operate the inspector in the debug thread when
+	started from sldb
+
+	* slime.el: Convert some inspector defuns to defun* and use
+	keywords. Other minor cleanups.
+
+2006-12-18  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-region-for-defun-at-point): end-of-defun and
+	beginning-of-defun modify match-data, added a save-match-data to
+	prevent this from affecting callers of
+	slime-region-for-defun-at-point.
+
+2006-12-15  Edi Weitz  <edi at agharta.de>
+
+	* swank-lispworks.lisp (make-weak-key-hash-table): Weak hash
+	tables for Lispworks.
+	(make-weak-value-hash-table): Ditto.
+
+2006-12-14  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*sldb-printer-bindings*): *PRINT-LINES* is in
+	effect only if *PRINT-PRETTY* is non-NIL, so it better to enable
+	the pretty printer.  Suggested by Madhu <enometh at meer.net>.
+
+	* slime.el (slime-expand-abbreviations-and-complete): Emacs
+	`choose-completion' (choosing a completion from the *Completions*
+	buffer) always replaces text upto (point). So the code which
+	figures out an `unambiguous-completion-length' and places the
+	point there in `slime-expand-abbreviations-and-complete' causes
+	problems: the replacement text gets garbled.  Get rid of the bogus
+	`unambiguous-completion-length'.  Patch by Madhu <enometh at meer.net>
+
+	* swank-cmucl.lisp (remove-gc-hooks): The variables
+	EXT:*GC-NOTIFY-AFTER* and EXT:*NOTIFY-BEFORE* should hold
+	functions and should be NIL. This affects the function
+	REMOVE-GC-HOOKS in swank-cmucl.lisp which sets them to
+	NIL, (should one happen to use it).  Set them back to the original
+	parameters.  Patch by Madhu <enometh at meer.net>
+
+	* slime.el (slime-repl-output-mouseover-face): Fix a pair of extra
+	parens.  Patch by Madhu <enometh at meer.net>
+
+2006-12-14  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-search-buffer-package): Remove Xemacs special
+	casing.  There's already a compatibility defun for
+	match-string-no-properties.
+
+2006-12-13  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* swank.lisp: FIX: fuzzy completion for M-V-B. Fix by Madhu.
+
+2006-12-12  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank.lisp (inspect-for-emacs integer): Pad the hex formatted
+	value to eight digits, "Code-char:" instead of "Corresponding
+	character:", "Integer-length:" instead of "Length:",
+	"Universal-time:" instead of "As time".
+	(inspect-object): Use TYPE-FOR-EMACS instead of TYPE-OF.
+	(inspect-in-emacs): New function, analogous to ED-IN-EMACS.
+
+	* swank-backend.lisp (type-for-emacs): New generic function,
+	defaults to TYPE-OF for non-integers, and returns FIXNUM or BIGNUM
+	for integers.
+
+	* slime.el (destructure-case): Indicate in the error message that
+	it was the Elisp destructure-case that failed to avoid confusion.
+	(slime-check-eval-in-emacs-enabled): More verbose error message.
+
+2006-12-11  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* swank.lisp: Added [set value] command for slot inspecting
+
+	* slime.el: Work on repl history navigation, restore old M-p/M-n
+	behaviour due to #lisp demand
+
+	Also print the current regexp in the minibuffer messages.  M-p/M-n
+	takes the repl input up to the point not the entire input as it
+	did before.
+	slime-repl-previous/next-input-starting-with-current-input: new
+	names for the old M-p/M-n commands History navigation commands
+	jump to the end of buffer when point is before the prompt.
+
+	* slime.el: Fix/smarten up temp-buffer-quit
+
+	Now it tries its best to remember the original window config and
+	restore it at slime-temp-buffer-quit unless it was changed
+	meanwhile. IOW, fix "q" after macroexpand in a macroexpand buffer
+	not closing the temp window.
+	Also fix the compiler notes usage of the temp buffer.
+
+	* swank-backend.lisp, swank.lisp:
+	Added inspect-slot-for-emacs to let users customize it.
+
+	Use all-slots-for-inspector everywhere, render link to both the
+	effective and direct slots when both are available.  Dropped
+	slot-value-using-class-for-inspector and friends.  Added
+	slot-makunbound-using-class to the swank-mop package and added
+	a [make-unbound] action to the standard slot presentation.
+
+	* slime.el: FIX: slime-symbol-name-at-point for symbols like
+	foo::|bar::baz|
+
+	* .cvsignore, swank.lisp: FIX: Drop #\. and add #\, to escaped
+	symbol chars
+
+	* slime.el: Added slime-repl-delete-from-input-history that
+	deletes the current history entry when no input is supplied
+
+	* slime.el: slime-repl-kill-input kills the entire input when
+	point is at the prompt and resets the history navigation state
+
+	* slime.el:
+	Use a hashtable to remove duplicates in slime-repl-merge-histories
+
+2006-12-07  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (init-inspector): Added eval parameter. If NIL we
+	don't eval FORM but limit our selves to cl:read'ing it and
+	inspecting that value.
+
+	* slime.el (slime-inspect): If a prefix argument is provided pass
+	:eval nil to swank:init-inspector.
+
+2006-12-07  Paul Collins <paul at briny.ondioline.org>
+
+	* hyperspec.el (common-lisp-hyperspec): Strip all text properties
+	from the symbol-at-point to avoid problems with read-only text.
+	
+2006-12-06  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-search-buffer-package): Don't call
+	match-string-no-properties if it's not defined (as is on some
+	xemacs')
+	(slime-repl-clear-buffer): Added optional prefix argument
+	specifying how many lines to leave.
+
+2006-12-06  Johan Bockgård  <bojohan+sf at dd.chalmers.se>
+
+	* swank.lisp (fuzzy-completion-set): Don't mix for clauses and
+	body clauses in loop.
+
+2006-12-05  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (create-swank-server): Removed. Use create-server
+	instead.
+	
+	* slime.el (slime-first-change-hook): Don't do anything if buffers
+	file doesn't exist.
+	(slime-start, slime-set-connection-info): Add support for a
+	:init-function which is called after the usual initialization of the
+	connection is completed.
+
+	* swank-source-file-cache.lisp (buffer-first-change): Always
+	return nil and remove the now redundant test with probe-file.
+
+	* swank-backend.lisp (guess-external-format): Return nil if the
+	file can't be opened.  Previusly we wrongly read from stdin.
+	
+2006-12-05  Juho Snellman  <jsnell at iki.fi>
+	
+	Real xref support for SBCL (requires SBCL 1.0.0.18).
+	
+	* swank-sbcl.lisp (who-calls): New function, fetch xref data from
+	sb-introspect.
+	(who-binds): Ditto.
+	(who-sets): Ditto.
+	(who-references): Ditto.
+	(who-macroexpands): Ditto.
+	(defxref): New macro, create the above functions.
+	(source-location-for-xref-data): New, map from sb-introspect xref
+	format to the Swank xref format.
+	(sanitize-xrefs): Map PCL method names to something more readable.
+	(string-path-snippet): New function, finds a more accurate source
+	snippet for definition source locations which have both an 
+	:emacs-string and a full source path available. Otherwise the xref
+	location would point to the toplevel form rather than the exact 
+	form for functions compiled with C-c C-c.
+	(source-file-position): New function, somewhat like
+	source-path-file-position but uses the source-file cache, handles
+	missing form-paths more gracefully.
+	(make-definition-source-location): Use the above two functions.
+	(sbcl-with-xref-p): New function, detect whether SBCL has xref support
+	for backwards compability.
+	
+2006-11-26  Juho Snellman  <jsnell at iki.fi>
+
+	* swank-source-file-cache.lisp (buffer-first-change): Check
+	whether a file exists before trying load it into the source cache.
+	
+2006-11-26  Juho Snellman  <jsnell at iki.fi>
+
+	Restore the way M-n and M-p used to work in the REPL. (cherry-picked
+	from a patch with other changes, sent by Attila Lendvai).
+
+	* slime.el (slime-repl-previous-input-starting-with-current-input)
+	(slime-repl-next-input-starting-with-current-input): New functions,
+	work like the old slime-repl-previous-input / next-input.
+	(slime-repl-matching-input-regexp): Restore old version.	
+	(slime-repl-mode-map): Bind s-r-p-i-s-w-c-i and s-r-n-i-s-w-c-i
+	to M-p and M-n respectively. slime-repl-previous-input and
+	slime-repl-next-input are still accessible with C-up / C-down.
+	
+2006-11-25  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-read-break): Use a :emacs-interrupt message
+	instead of a RPC to swank:simple-break.  Suggested by Taylor R
+	Campbell.
+
+2006-11-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-search-buffer-package): Prettify the package
+	name if it is written as string or keyword.
+
+2006-11-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-in-expression-p): Use `read' and `eq' to test
+	the first element of the list.  Previuosly, the pattern (foo)
+	wrongly matched (foobar) because we used (looking-at <symbol>).
+
+	* swank-cmucl.lisp (setf-definitions): Also include defs which
+	were created with (defun (setf NAME) ...).  Previously we only
+	found definitions created with defsetf or define-setf-expander.
+
+2006-11-22  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-edit-definition): Don't hide error messages.
+
+2006-11-21  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*coding-system*): "Coding systems" are now strings
+	instead of keywords.
+
+2006-11-19  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-compile-file): Let the Lisp side choose the
+	coding system.
+	(slime-coding): Deleted.
+
+	* swank.lisp (compile-file-for-emacs): Use guess-external-format.
+	(swank:create-server): no more accepts an  :external-format 'enc ,
+	use  :coding-system "enc"  instead.
+	
+	* swank-backend.lisp (find-external-format)
+	(guess-external-format): New.
+	(swank-compile-file): The external-format argument is now a
+	backend specific value returned by find-external-format.
+
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-clisp,
+	swank-lispworks.lisp, swank-allegro.lisp, swank-corman.lisp,
+	swank-ecl.lisp, swank-scl.lisp, swank-abcl.lisp, swank-openmcl:
+	Update implementations accordingly.
+
+	* swank-source-file-cache.lisp (read-file): Use guess-external-format.
+	
+	* swank.lisp (*swank-wire-protocol-version*): Is now initialized
+	by the loader.
+	(wire-protocol-version): Removed, because it contained a reference
+	to swank-loader::*source-directory*.
+
+	* slime.el (slime-set-connection-info): On protocol version
+	mismatch, ask the user how to proceed.
+	(slime-protocol-version): New variable. Initialize it at compile
+	time to detect stale elc files.
+
+	* swank-loader.lisp (load-swank): Set the protocol version.
+	
+2006-11-12  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-make-tramp-file-name): Added (require 'tramp)
+	since tramp-make-tramp-file-name is not an autoloaded function.
+
+2006-11-07  Edi Weitz  <edi at agharta.de>
+
+	* slime.el (slime-fuzzy-completion-time-limit-in-msec): Escaped
+	left parenthesis in doc string.
+
+2006-11-05  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-complete-keywords-contextually): Unused
+	variable, removed.
+
+2006-11-05  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (sldb-sexp-highlight-mode): Remove bloat.
+
+2006-11-04  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Support nested presentations in REPL results, when present.lisp is
+	loaded. 
+	
+	* swank.lisp (make-presentations-result): New, factored out from
+	listener-eval. 
+	(listener-eval): Use it here.
+
+	* present.lisp (make-presentations-result): Override it here.
+
+2006-11-03  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (all-slots-for-inspector): Added declare ignore for
+	unused argument inspector (openmcl warns about this). Reindented.
+
+2006-11-01  Attila Lendvai  <attila.lendvai at gmail.com>
+       
+	* slime.el (sldb-sexp-highlight-mode): New custom.
+	(slime-handle-repl-shortcut): Trigger slime-lookup-shortcut when
+	the point is anywhere before slime-repl-input-start-mark.  IOW,
+	you can press "," anywhere before the prompt.
+	(slime-edit-definition): Handle the case when there are only such
+	entries returned from swank that have errors.
+	(slime-read-from-minibuffer): Allow overriding of the keymap.
+	(slime-repl-previous-matching-input): Similar behaviour like
+	isearch-forward.
+	(slime-repl-next-matching-input): Ditto. In more details: You can
+	freely navigate with slime-repl-previous/next-input with M-p and
+	M-n at any time among the history entries.  When M-r is pressed,
+	which invokes slime-repl-previous-matching-input, the the
+	minibuffer is activated to read the regexp to search for and the
+	contents will default to the current repl input.  Pressing M-r
+	again will start searching with the last pattern used no matter
+	what the content of the minibuffer is. Subsequent invocations of
+	M-r get the next match, and of course the same applies for M-s,
+	which is slime-repl-previous-matching-input.
+
+	* swank.lisp (fuzzy-completion-set): Fix on clisp.
+	(convert-fuzzy-completion-result): Fix symbol fbound and other
+	annotations.
+	(slot-value-using-class-for-inspector): New.
+	(slot-boundp-using-class-for-inspector): New.
+	(inspect-for-emacs): Use the special slot access methods so that
+	it's possible to customize the inspecting of complex
+	slots (e.g. computed-class at
+	http://common-lisp.net/project/computed-class/).
+	(all-slots-for-inspector): Converted to generic method.
+
+2006-11-01  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (*swank-wire-protocol-version*): Use a defvar to
+	declare the existence of tihs variable to the lisp (Reported by:
+	Jonathon McKitrick <jcm at FreeBSD-uk.eu.org>).
+	
+2006-10-30  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (*dont-close*): New variable.
+	(defpackage :swank): Export *dont-close*.
+	(start-server, create-server): Use *dont-close* as the default
+	value of the :dont-close parameter.
+	(connection-info): Send the wire-protocol-version (supplied by the
+	swank-version.el file) to slime when connecting.
+	(wire-protocol-version): New function.
+
+	* slime.el (slime-global-variable-name-regexp): New variable.
+	(slime-global-variable-name-p): Use
+	slime-global-variable-name-regexp.
+	("swank-version"): Load swank-version.el to get the wire protocol
+	version.
+	(slime-set-connection-info): Check the wire protocol version.
+
+2006-10-30  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-global-variable-name-p): Oops... need to handle
+	very long strings.
+
+2006-10-29  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el (slime-global-variable-name-p): Use defun* instead of
+	defun.
+
+2006-10-29  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-global-variable-name-p): Simplified.
+
+2006-10-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Add completion for character names. 
+	
+	* slime.el (slime-completions-for-character): New.
+	(slime-contextual-completions): Use it here.
+
+	* swank-backend.lisp (character-completion-set): New interface.
+
+	* swank-allegro.lisp (character-completion-set): Implement it.
+
+	* swank.lisp (completions-for-character): New slimefun.
+	(compound-prefix-match/ci/underscores) 
+	(longest-completion/underscores, tokenize-completion/underscores) 
+	(untokenize-completion/underscores): New functions.
+
+2006-10-28 Ivan Toshkov <ivan at toshkov.org>
+
+	* hyperspec.el: Missing Hyperspec links for ~| and ~~
+
+2006-10-27 Ivan Toshkov <ivan at toshkov.org>
+
+	* hyperspec.el: Missing Hyperspec links for ~% and ~&
+	
+2006-10-27 Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp (make-weak-key-hash-table): Restore support
+	for older SBCLs without weak hash-tables.
+	(make-weak-value-hash-table): Ditto.
+
+2006-10-26  Utz-Uwe Haus  <haus+slime at mail.math.uni-magdeburg.de>
+
+	* swank-allegro.lisp (sldb-break-at-start): Implement.
+
+2006-10-26  Attila Lendvai  <attila.lendvai at gmail.com>
+   
+	* slime.el (slime-setup-command-hooks): Use make-local-hook.
+	(slime-repl-mode): Ditto.
+	(slime-fuzzy-choices-buffer): Ditto.
+	(sldb-mode): Ditto.
+	(slime-fuzzy-completion-limit): New variable.
+	(slime-fuzzy-completion-time-limit-in-msec): New variable.
+	(slime-fuzzy-next): Fix when at the end of the buffer.
+	(completion-output-symbol-converter): New to handle escaped
+	symbols for those who need to mess around with symbols like
+	layered-function-definers::|CONTEXTL::SLOT-VALUE-USING-LAYER|.
+	When a symbol is escaped then completion is case sensitive.
+	(completion-output-package-converter): New.
+	(mimic-key-bindings): New to easily define bindings by first
+	trying to look up bindings for an operation and only use the
+	provided default bindings if nothing was found in the source
+	keymap. Use it to set up fuzzy bindings. (Hint: if you have keys
+	like previous-line customized, then only load slime after they
+	have been set, and the fuzzy mode will mimic them.)
+	(slime-temp-buffer-quit): Always close the opened window, updated
+	docstring.  Also made the fuzzy maps smarter, they now try to look
+	up keys with 'where-is-internal and map the functions on them.
+   
+	* swank-sbcl.lisp
+	(make-weak-value-hash-table): New for sbcl.
+	(make-weak-key-hash-table): New for sbcl.
+   
+	* swank.lisp (fuzzy-completions and friends): Added :limit and
+	:time-limit-in-msec keyword params. Used vectors instead of lists
+	that nearly doubled its speed (at least on sbcl).  Also added some
+	declare optimize and type annotations.
+	(do-symbols*): New, uses a hash-table to visit only non-seen
+	symbols. Replaced various uses of do-symbols where it was
+	appropiate.
+
+2006-10-26  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-global-variable-name-p): Use a custom 'parser'
+	instead of string-match to avoid regexp overflow errors on very
+	long strings.
+
+2006-10-21  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-lispworks.lisp (initialize-multiprocessing): Don't init
+	MP if it is already running.
+
+	* test.sh: Run Emacs in Screen.
+
+2006-10-20  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-backend.lisp, swank-cmucl.lisp:
+	(startup-idle-and-top-level-loops): Deleted. Merged into
+	initialize-multiprocessing.
+
+2006-10-20  Attila Lendvai  <attila.lendvai at gmail.com>
+	
+	* slime.el (slime-fuzzy-choices-buffer): Added kill-buffer-hook to
+	the completion buffer to slime-fuzzy-abort, so we get out from the
+	completion mode and key maps when the completion buffer is closed.
+
+2006-10-20  Marco Baringer  <mb at bese.it>
+	
+	* slime.el (slime-target-buffer-fuzzy-completions-map): Fix a bug
+	I introduced when applying levente's patch.
+
+2006-10-20  Martin Simmons <martin at lispworks.com>
+
+	* swank-backend.lisp (initialize-multiprocessing): New API to
+	support lisps where initialize-multiprocessing may not return (lispworks).
+
+	* swank.lisp (start-server): initialize-multiprocessing's API has changed.
+
+	* swank-lispworks.lisp (initialize-multiprocessing): Update for new API.
+
+	* swank-cmucl.lisp (initialize-multiprocessing): Update for new API.
+	
+	* swank-allegro.lisp (initialize-multiprocessing): Update for new api.
+	
+2006-10-20  Levente Mészáros <levente.meszaros at gmail.com>
+
+	Added "in-place" fuzzy completion GUI. See
+	slime-fuzzy-completions-map and
+	slime-target-buffer-fuzzy-completions-map for details.
+
+	* slime.el (slime-fuzzy-completion-in-place): New variable.
+	(slime-target-buffer-fuzzy-completions-mode): New keymap for
+	in-place fuzzy completions.
+	(slime-fuzzy-target-buffer-completions-mode): New minor mode for
+	in-place fuzzy completions.
+	(slime-fuzzy-current-completion-overlay): New overlay for
+	highlighting currently selected completion.
+	(slime-fuzzy-completions-map): Added new fuzzy completon keys
+	(slime-fuzzy-indent-and-complete-symbol): New function.
+	(slime-fuzzy-complete-symbol): Use new in-place fuzzy completion.
+	(slime-fuzzy-choices-buffer): Support in-place completion editing.
+	(slime-fuzzy-fill-completions-buffer): Highlight completions,
+	don't automatically jump to completion buffer.
+	(slime-fuzzy-enable-target-buffer-completions-mode,
+	slime-fuzzy-disable-target-buffer-completions-mode): New modes for
+	moving in/out of in-place fuzzy completion mode
+	(slime-fuzzy-next, slime-fuzzy-prev): Don't assume point is in the
+	completion buffer.
+	(slime-fuzzy-dehighlight-current-completion,
+	slime-fuzzy-highlight-current-completion): Manage completion
+	selection highlighting.
+	(slime-fuzzy-select-or-update-completions): New function.
+	(slime-fuzzy-process-event-in-completions-buffer): New function.
+	(slime-fuzzy-select-and-process-event-in-target-buffer): New function.
+	(slime-fuzzy-done): Changed to deal with in-place completion.
+	
+2006-10-19  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-backend.lisp (ignored-xref-function-names): Deleted.
+
+	* swank.lisp (guess-package-from-string): Remove special case for
+	"#.". parse-package will handle that just fine.
+	(find-definitions-for-emacs): Don't filter errors out.
+	(sanitize-xrefs): Moved to swank-sbcl.  The backend is supposed to
+	return sane values. 
+
+	* swank-sbcl.lisp: See above.
+	
+	* slime.el (slime-find-buffer-package): Simplify.
+
+2006-10-17  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-accept-process-output): The timeout arg can be
+	nil. Handle that case.
+
+2006-10-17  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime.el (slime-find-buffer-package): Handle #. forms.
+
+	* swank.lisp (guess-package-from-string): Handle #. forms.
+	(inspect-for-emacs standard-class): Handle non-string
+	:documentation slot contents.
+
+	* swank-sbcl.lisp (inspect-for-emacs weak-pointer ...): Added
+	method.
+	
+2006-10-16  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (sldb-activate): Get debug-info from the correct
+	thread. Fixes bug reported by Dan Weinreb <dlw at itasoftware.com>.
+	(unwind-to-previous-sldb-level): New test.
+	(slime-init-command): Send a single form.
+	(slime-insert-presentation): Honor slime-repl-enable-presentations.
+	Presentations kill SLDB and the inspector in Emacs 20 (besides
+	being troublesome GC-wise).
+
+	* swank.lisp: Clean up global IO redirection.
+	(setup-stream-indirection): Turn macro into a
+	function and delay initialization after user init files are
+	loaded, so that we do nothing if *globally-redirect-io* is nil.
+	(*after-init-hook*, run-after-init-hook)
+	(init-global-stream-redirection): New.
+
+	(parse-symbol-or-lose): Lose loudly and early (instead of failing
+	silently).
+	
+	* swank-loader.lisp: Abort on compile-time or load-time errors.
+	Don't try to load the source-file if COMPILE-FILE's 3rd return
+	value is true (it's true even for warnings).
+	(handle-loadtime-error): New function.
+	
+	Run the after-init-hook.
+
+	* swank-cmucl.lisp (inspect-for-emacs): Don't break for
+	simple-strings.
+
+2006-10-11  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-presentation-syntax-table): New.
+	(slime-add-presentation-properties): Install it in a syntax-table
+	text property, so that #<...> is balanced in a presentation.
+	(slime-remove-presentation-properties): Remove the text property.
+	(slime-repl-mode): Respect the syntax text properties of
+	presentations in REPL buffers.
+
+2006-10-09  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (completions-for-keyword): Look up the operator names
+	in the right package.  Return nil (rather than signalling an
+	error) when no valid operator name is present.
+
+2006-10-08  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-loader.lisp (lisp-version-string) [allegro]: Distinguish
+	between 32-bit and 64-bit version on the SPARC architecture.
+
+2006-10-03  Marco Baringer  <mb at bese.it>
+
+	Change license statement to say that all files without an explicit
+	copyright notice are public domain. This change will allow SLIME
+	to moved out of debian's nonfree tree.
+	
+	* README: Update license statement.
+
+2006-10-02  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-highlight-compiler-notes): New variable.
+	(slime-compilation-finished): Only highlight notes when
+	slime-highlight-compiler-notes is non-NIL.
+
+2006-09-28  Marco Baringer  <mb at bese.it>
+
+	* swank-loader.lisp (compile-files-if-needed-serially): Don't
+	ignore compile-time errors but drop into a debugger (it's not a
+	slime debugger but it's certainly better than ignoring the error).
+
+2006-09-27  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (*globally-redirect-io*): Change default value to T.
+
+2006-09-25  Juho Snellman  <jsnell at iki.fi>	
+
+	Fix Slime on SBCL 0.9.17.
+	
+	* swank-backend.lisp (ignored-xref-function-names): New interface
+
+	* swank.lisp (sanitize-xrefs): Use ignored-xref-function-names
+	instead of having a #+sbcl special case.
+	
+	* swank-sbcl.lisp (ignored-xref-function-names): Implement.
+	Filter out SB-C::STEP-VALUES, not just SB-C::STEP-FORM, as done by
+	the old sanitize-xrefs.	Don't implement the interface at all if
+	SBCL is sufficiently new (those symbols don't exist any more, and
+	there's nothing in their place to be ignored).
+
+2006-09-21  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (find-definitions-for-emacs): Don't return locations
+	whose CAR is :error.
+	(xref): Process whatever is returned by the various xref functions
+	with the new sanitize-xrefs functions.
+	(sanitize-xrefs): Clean up the list of xrefs to remove duplicates.
+	Patch by Dan Weinreb <dlw at itasoftware.com>
+
+	* slime.el (slime-goto-first-note-after-compilation): New
+	variable. This controls the behaviour of (next|prev)-note
+	immediatly after a slime-compile-and-load-file.
+	(slime-compilation-just-finished): New variable.
+	(slime-compilation-finished): Update slime-compilation-finished.
+	(slime-next-note, slime-previous-note): Respect
+	slime-compilation-just-finished.
+	(slime-autodoc-use-multiline-p): Specify the type.
+	(slime-repl-grab-old-input): Typo in docstring.
+	(slime-cheat-sheet): Deal with multiple-bindings
+	(slime-cheat-sheet-table): Update as per #lisp's suggestions.
+	
+2006-09-20  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-cheat-sheet): New function.
+	(slime-cheat-sheet-table): New variable which specifies what the
+	cheat sheet should list.
+	(slime-read-package-name): Set require to T in the call to
+	completing read, it doesn't make any sense to switch to an
+	inexistent package.
+	
+	* doc/slime.texi: Added "Tips and Tricks" chapter (need a better
+	name for this).
+
+	* swank-sbcl.lisp (fallback-source-location): Use abort-request
+	instead of error.
+	(locate-compiler-note): Say, in the error message, what data
+	caused the error.
+
+2006-09-20  Juho Snellman  <jsnell at iki.fi>	
+	
+	* swank-sbcl.lisp (call-with-debugger-hook): use INVOKE-STEPPER
+	instead of calling the stepper hook manually
+	
+2006-09-19  Juho Snellman  <jsnell at iki.fi>	
+	
+	* swank-sbcl.lisp (call-with-debugger-hook): make the stepper
+	also work with a threaded SBCL, by binding a handler for
+	sb-ext:stepper-condition instead of relying on the one that SBCL
+	establishes on the toplevel
+	
+2006-09-19  Juho Snellman  <jsnell at iki.fi>
+
+	Extend the stepper protocol to work nicely with the SBCL stepper.
+
+	If sldb is invoked on a condition that's sldb-stepper-condition-p,
+	the sldb functions sldb-step, sldb-next and sldb-out will invoke
+	the matching backend functions for stepping into the stepped form,
+	to the next form, or out of the current function. Otherwise the
+	functions will behave like sldb-step used to (call active-stepping and
+	select the continue restart).
+
+	* swank-backend.lisp (sldb-stepper-condition-p, sldb-step-into, 
+	sldb-step-next, sldb-step-out): New interface functions
+	
+	* swank-sbcl.lisp (activate-stepper, condition-extras,
+	sldb-stepper-condition-p, sldb-step-into, sldb-step-next,
+	sldb-step-out): Implemented (conditional on CVS SBCL)
+	(call-with-debugger-hook): bind sb-ext:*stepper-hook* to
+	a function that binds *stack-top-hint* and invokes the debugger
+	(conditional on CVS SBCL)
+	
+	* swank.lisp (define-stepper-function): new macro for defining 
+	stepper-related functions, since they all follow the same form
+	(sldb-step): redefine with define-stepper-function
+	(sldb-next, sldb-out): new functions
+	(*sldb-stepping-p*): typo in docstring
+	
+	* slime.el (sldb-next, sldb-out): New commands
+        (sldb-mode-map): bind sldb-next to "x" and sldb-out to "o"
+	
+2006-09-18  Dan Weinreb <dlw at itasoftware.com>
+
+	For those cases where SLIME can't complete a user request (like
+	loading an asdf system without asdf or describing an inexistent
+	symbol) instead of signaling an error SWANK should politely inform
+	the user and return normally.
+
+	* swank.lisp (eval-for-emacs): Handle request-abort conditions.
+	(decode-keyword-arg, get-repl-result, parse-symbol-or-lose): Use
+	abort-request instead of error.
+	
+	* swank-backend.lisp (request-abort): New condition.
+	(abort-request): Convenience function for signaling request-abort
+	conditions.
+	(operate-on-system): Use abort-request instead of error
+	(:swank-backend): Export the symbols abort-request and
+	request-abort.
+
+	* slime.el (slime-rex): Update docstring.
+	(slime-eval, slime-eval-async): Added new REASON parameter sent
+	along with :abort message.
+
+2006-09-14  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl (arglist, function-arglist, spawn): update for the SCL.
+
+2006-09-13  Brandon Bergren <bdragon at mailsnare.net>
+
+	* slime.el (slime-filename-translations): Fix docstring
+
+2006-09-13  Bob Halley <halley at play-bow.us>
+
+	* swank.lisp (format-iso8601-time): Properly handle non integer
+	time zones.
+
+2006-09-13  Taylor R Campbell <campbell at mumble.net>
+
+	* slime.el (slime-init-output-buffer): Initial directory and
+	package stacks should be empty.
+	(slime-repl-push-package): Push the current package, as opposed to
+	the new package, and set the new package to whatever the user
+	specified.
+	(slime-repl-pop-package): Set the current package to the top of
+	the package stack, unless it's empty.
+
+2006-09-13  Daniel Koning <dkoning at seas.smu.edu>
+
+	* slime.el (slime-repl-disconnect): New repl shortcut.
+
+2006-09-13  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-open-inspector): Added a slime-part-number
+	property to the topline so that you can slime-inspector-copy-down
+	the object being inspected. There are some cases where we have an
+	object in the inspector and we'd like to dump it to the repl but
+	we can't get at it through other means (like in back-traces).
+	(slime-insert-xrefs): Specify which file the item is in (when that
+	information is available).
+
+	* swank.lisp (format-arglist-for-echo-area): Instead of using
+	let+first+rest to destructure a form use destructuring-bind.
+	(lookup-presented-object): Added (declare (special
+	*inspectee-parts*)) to silence openmcl's compiler.
+	(inspect-object): Generate, and send to emacs, an ID for the
+	object being inspected.
+
+2006-09-01  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* slime.el (slime-repl-matching-input-regexp): Use the portion
+	between slime-repl-input-mark and point for history search, not
+	the entire input. Patch by Ivan Shvedunov.
+
+	* swank-sbcl.lisp: Declaim SB-C:INSERT-STEP-CONDITIONS 0 for to
+	hide Swank while stepping and avoid endless mutex-acquisition
+	loops.
+
+2006-08-27  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (input-available-p, process-available-input): Use
+	READ-CHAR-NO-HANG instead of LISTEN because LISTEN suddenly
+	returns false in SBCL 0.9.?? even if we are called from a
+	fd-handler and the OPEN-STREAM-P returns true.
+
+2006-08-26  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-repl-return-behaviour): Fix the defcustom type,
+	so Emacs 21.3 does not signal an error when creating a
+	customization buffer containing this variable.
+
+2006-08-25  Kai Kaminski <kai.kaminski at gmx.de>
+
+	* swank.lisp (lookup-presented-object): Fix for OpenMCL 1.0
+	[ppc32], which requires that the :NO-ERROR clause is last in
+	HANDLER-CASE.
+
+2006-08-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-ensure-presentation-overlay): Provide a
+	help-echo for presentations, showing the mouse bindings.
+	(slime-presentation-around-click): New function.
+	(slime-copy-or-inspect-presentation-at-mouse)
+	(slime-inspect-presentation-at-mouse) 
+	(slime-copy-presentation-at-mouse) 
+	(slime-describe-presentation-at-mouse) 
+	(slime-pretty-print-presentation-at-mouse): New commands.
+	(slime-copy-presentation-at-point): Removed (misnomer).
+	(slime-presentation-map): Bind mouse-2 to
+	slime-copy-or-inspect-presentation-at-mouse, so the right thing is
+	done in REPL buffers and in Inspector and Debugger buffers.
+	(slime-menu-choices-for-presentation): Use the new commands here
+	instead of inline lambdas.
+	(sldb-inspect-in-frame): Use slime-read-object here, so if point
+	is in a presentation in the debugger buffer, inspect it
+	immediately just like slime-inspect does.
+	(slime-inspect-presented-object): Removed.
+	(slime-inspect): Don't expect that "swank:init-inspector" is
+	already part of the form.  Accept an optional arg "no-reset".
+	(slime-read-object): Don't add "swank:init-inspector" to the read
+	form; slime-inspect now adds it.
+
+2006-08-21  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Make the values of local variables in debugger frames and values
+	of parts in the inspector accessible as presentations.  In
+	particular, this allows to copy #<unreadable> values to the REPL
+	for further investigation.  It also provides a context menu for
+	the values, offering to inspect, pretty-print, and describe them.
+
+	Note that the presentations are only valid as long as the
+	corresponding Inspector or Debugger buffer is open.
+	
+	* swank.lisp (lookup-presented-object): Handle presentation ids
+	(:frame-var frame index), (:inspected-part part-index).
+	(init-inspector): New optional argument, reset.
+
+	* slime.el (slime-inspector-insert-ispec): Mark up all values of
+	inspected parts as presentations. 
+	(sldb-insert-locals): Mark up the values of local variables as
+	presentations. 
+	(slime-remove-presentation-properties): Fix for read-only buffers.
+	(slime-copy-presentation-at-point): Make it work when the current
+	buffer is not the REPL buffer.
+	(slime-menu-choices-for-presentation): Describe into a separate
+	buffer, not the REPL.  New menu item, pretty-print.
+	(slime-presentation-expression): Handle presentation ids that are
+	not numbers.
+	(slime-inspect-presented-object): Don't reset the inspector if
+	already in the inspector buffer.
+
+2006-08-20  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (*nil-surrogate*): New.
+	(save-presented-object, lookup-presented-object): Distinguish
+	between a saved NIL and a garbage-collected object that was
+	replaced by NIL in the weak hash table.
+	(compute-enriched-decoded-arglist with-open-file): Add an IGNORE
+	declaration. 
+
+2006-08-19  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-parse-extended-operator-name/apply): New.
+	(slime-extended-operator-name-parser-alist): Add it to the alist.
+
+	* swank.lisp (compute-enriched-decoded-arglist): Add method for
+	handling APPLY.
+
+2006-08-14  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-accept-process-output): Use brute-force to
+	detect whether accept-process-output can be called with a float as
+	timeout arg.
+
+	* swank-openmcl.lisp: Fix some breakage caused by the new
+	defimplementation.
+
+2006-08-11  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (close-connection, swank-error): Include backtraces
+	in our own errors.
+	(simple-serve-requests): Don't try to enter the
+	debugger if the connection is closed.
+
+	* slime.el (disconnect): Test disconnecting.
+
+	* swank-cmucl.lisp (startup-idle-and-top-level-loops): Initialize
+	MP only once.
+
+2006-08-10  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (fspec-definition-locations): Improve
+	handling of (:internal ... n) like fspecs.
+
+	* slime.el (slime-restart-inferior-lisp-aux): Remove the
+	interactive spec.
+	
+	* swank-backend.lisp (definterface): Drop that incredibly
+	unportable CLOS stuff. Use plists and plain functions instead.
+	Update backends accordingly.
+
+2006-08-09  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-find-filename-translators): CL:MACHINE-INSTANCE
+	can return nil.  Silently accept that case for now.
+
+	* swank.lisp (test-print-arglist): Print a message instead of
+	signalling an error. This should avoid startup problems, in
+	particular with CormanLisp.
+	(setup-stream-indirection): Disable it for now.  We should fix it,
+	if there is a need for this functionality or just remove it.
+
+	* swank-backend.lisp (definterface): Bring the old implementation
+	based on NO-APPLICABLE-METHOD back.  It avoids lots of redefintion
+	warnings (but it creates more "noise" in backtraces).
+
+	* swank-*.lisp (inspect-for-emacs): Don't use defimplementation
+	for real generics.
+
+2006-07-28  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-thread-quit): Call swank:quit-thread-browser.
+	Reported by Taylor R Campbell.
+
+2006-07-28  Willem Broekema <metawilm at gmail.com>
+
+	* swank-allegro.lisp: Profiling functions on Allegro (except for
+	profile-package).
+
+2006-07-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Add support for destructuring macro arglists in arglist display,
+	form completion, and keyword completion; in particular for
+	with-open-file.
+	
+	* swank.lisp (find-valid-operator-name): New, factored out from
+	arglist-for-echo-area.
+	(arglist-for-echo-area): Use it here.
+	(print-arglist): New, factored out from decoded-arglist-to-string.
+	Handle recursive arglist structures that arise in destructuring
+	macro arglists.
+	(decode-required-arg, encode-required-arg): New, handle
+	destructuring patterns.
+	(decode-keyword-arg, encode-keyword-arg, decode-optional-arg) 
+	(encode-optional-arg, decode-arglist, encode-arglist): Use them
+	here to handle destructuring patterns.
+	(print-decoded-arglist-as-template): Change interface, handle
+	destructuring patterns.
+	(decoded-arglist-to-template-string): Use it here.
+	(enrich-decoded-arglist-with-keywords): New, factored out from
+	enrich-decoded-arglist-with-extra-keywords. 
+	(enrich-decoded-arglist-with-extra-keywords): Use it here.
+	(compute-enriched-decoded-arglist): New generic function, factored
+	out from arglist-for-insertion, form-completion.  Add specialized
+	method for with-open-file.
+	(arglist-for-insertion, form-completion): Use it here.
+	(arglist-ref): New.
+	(completions-for-keyword): Change interface, handle destructuring
+	macro arglists.
+
+	* slime.el (slime-enclosing-operator-names): For nesting levels
+	without operator, record nil.
+	(slime-completions-for-keyword): New argument arg-indices. 
+	(slime-contextual-completions): Pass all enclosing operators and 
+	arg-indices to slime-completions-for-keyword.
+
+2006-07-16  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-edit-definition): Invoke the
+	slime-edit-definition-fall-back-function also in the case where
+	find-definitions-for-emacs returns an error message.
+	(slime-edit-definition-fallback-function): Fix typo (find-tag
+	rather than find-tags).
+
+2006-07-15  Juho Snellman  <jsnell at iki.fi>
+	
+	* swank-sbcl.lisp (preferred-communication-style): Remove use of
+	  linux_no_threads_p alien variable (the value has been hardcoded to
+	  false for about a year), so that we can also remove it from from SBCL
+	  in the future.
+	  (*definition-types*): defcondition -> define-condition,
+	  to make slime-show-definitions display condition FOO as
+	  (DEFINE-CONDITION FOO) instead of (SWANK-BACKEND::DEFCONDITION FOO).
+
+2006-07-15  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-shared-lisp-mode-hook): New function, factored
+	out from slime-lisp-mode-hook.
+	(slime-lisp-mode-hook): Use it here.
+	(slime-scheme-mode-hook): New function, use
+	slime-shared-lisp-mode-hook. 
+	(slime-setup): If scheme-mode is one of the slime-lisp-modes,
+	install our hook.
+
+2006-07-13  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (keywords-of-operator): New support function for
+	writing user-defined `extra-keywords' methods.
+
+2006-07-11  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (make-weak-key-hash-table): Use ACL's weak
+	hashtables.
+
+	* swank.asd: Set *source-directory* to the asdf component dir.
+
+2006-07-01  Luís Oliveira  <loliveira at common-lisp.net>
+ 
+	* swank-sbcl.lisp (locate-compiler-note): Change first branch to
+ 	handle the changes introduced by the previous patch to
+ 	swank-compile-string.
+
+2006-06-26  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (find-definitions): Remove backward
+	compatibility code.
+
+2006-06-26  Luís Oliveira <loliveira at common-lisp.net>
+
+	* swank-sbcl.lisp (tmpnam, temp-file-name): New functions.
+	(swank-compile-string): Create temporary file with the string and
+	compile-file it instead of compiling an anonymous lambda, as
+	before, in order to better handle eval-when forms.
+
+2006-06-25  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-source-path-parser.lisp (suppress-sharp-dot): Return a
+	unique symbol to avoid multiple entries for nil at toplevel in the
+	source-map.
+
+	* slime.el (test compile-defun): Add a test for #. reader macro at
+	toplevel.
+	(slime-run-one-test): New command.
+	(sldb-activate): Recreate the sldb buffer if it doesn't
+	exist. (Can happen if someone kills the buffer manually.)
+	(slime-wait-condition): Add a dummy to slime-stack-eval-tags while
+	waiting so that the SLDB enters a recursive edit.
+
+2006-06-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-echo-arglist): Simplify, just use slime-autodoc.
+
+	* swank.lisp (arglist): Distinguish between provided actual args
+	and required formal args using the new slot provided-args.
+	(form-completion): Likewise.
+	(decoded-arglist-to-string): Use it here to display the argument
+	list (make-instance 'CLASS-NAME ...) rather
+	than (make-instance (quote CLASS-NAME) ...).
+	
+	* swank.lisp (extra-keywords change-class): Don't drop the first
+	argument.
+
+	* slime.el (slime-parse-extended-operator-name): Don't move
+	point; fixes infinite loop.
+
+2006-06-17  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-parse-extended-operator-name/cerror): Handle
+	cerror and change-class with :make-instance.
+	(slime-extended-operator-name-parser-alist): Handle change-class.
+	(slime-parse-extended-operator-name)
+	(slime-enclosing-operator-names): Fix the case when point is
+	within the operator.
+
+	* swank.lisp (operator-designator-to-form): Handle cerror and
+	change-class with :make-instance.
+
+2006-06-16  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (operator-designator-to-form): Handle :cerror.
+	(extra-keywords cerror): Make it work.
+
+	* slime.el (slime-parse-extended-operator-name) 
+	(slime-parse-extended-operator-name/make-instance) 
+	(slime-parse-extended-operator-name/defmethod): New functions,
+	factored out from slime-enclosing-operator-names.
+	(slime-parse-extended-operator-name/cerror): New function.
+	(slime-extended-operator-name-parser-alist): New variable.
+	(slime-enclosing-operator-names): Use them here.
+
+2006-06-14  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-goto-definition): If all definitions of a name
+	have the same location, go there directly rather than presenting
+	an xref buffer.
+
+2006-06-11  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl (ext:stream-write-chars): update for SCL 1.3.
+
+2006-06-09  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* swank-abcl: Update to cvs version of abcl and warnings errors
+	when compiling in a buffer will now be properly caught by slime vs
+	current behavior of always saying 0 errors 0 warnings and printing
+	them in the repl instead
+	
+2006-05-31  Nathan Bird <nathan at acceleration.net>
+
+	* swank.lisp (*sldb-quit-restart*): New variable.
+	(throw-to-toplevel): Use the restart named by *sldb-quit-restart*
+	as opposed to hard coding abort-request.
+
+2006-05-30  Tobias Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-get-temp-buffer-create): New keyword REUSEP
+	which indicates whether an already-existing buffer named like the
+	buffer to be created should be reused, i.e. not killed, then
+	freshly created. Update docstring accordingly.
+	(slime-with-output-to-temp-buffer): Make &optional arg MODE an
+	&key keyword arg. Add REUSEP keyword.
+	(slime-macroexpansion-minor-mode-map): Make remapped `undo' update
+	highlighted edits in the macroexpansion buffer.
+	(slime-eval-macroexpand-in-place): Update highlighted edits when
+	macroexpanding in-place.
+	(slime-eval-macroexpand): Reuse macroexpansion buffer if it exists
+	already to preserve `undo' functionality.
+
+2006-05-30  Tobias Rittweiler <tcr at freebits.de>
+
+	* slime.el (slime-use-autodoc-mode): Fix typo in docstring.
+	(slime-use-highlight-edits-mode): New variable, analogous to
+	SLIME-USE-AUTODOC-MODE.
+	(slime-setup, slime-lisp-mode-hook): Make above variable
+	work. Also, activates the HIGHLIGHT-EDITS-MODE in proper way (thus
+	avoiding the nasty "Toggling ... off; better pass an explicit
+	argument." message.)
+
+	* slime.el: Fix typo in comment about communication protocol.
+
+2006-05-27  Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-abcl: slot-boundp-using-class slot-value-using-class  so you 
+	can inspect instances
+
+2006-05-26  Tobias C. Rittweiler <tcr at freebits.de>
+	
+	* slime.el (slime-eval-macroexpand-inplace): Fix out-of-range
+	error on in-place macroexpand when point is placed at a closing
+	parenthesis. In this case the sexp closed by that paren is
+	expanded.  
+	Also make expanding of expressions work that are quoted like, for
+	instance, "'(FOO BAR)" if point is placed at the opening paren.
+
+2006-05-24  Brian Downing  <bdowning at lavos.net>
+
+	* swank.lisp (recursively-compute-most-completions & friends):
+	Micro-optimize the fuzzy completion engine, improving performace
+	by a factor of about 4 on SBCL.  However, it will only work on
+	simple-strings now, and CHAR= is burned in instead of being an
+	option.  I don't think this is too much of a limitation.  At this
+	point rendering the results on the emacs side takes much longer
+	than finding them for long result lists.
+
+2006-05-24  Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-abcl: Add some more mop functions to you can inspect classes,
+	generic functions, methods, slots.
+	
+2006-05-16  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-repl-return-behaviour): New variable which
+	controls slime-repl-return's heaviour.
+	(slime-repl-return): Respect slime-repl-return-behaviour.
+
+2006-05-14  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-macroexpansion-minor-mode-map): Rebind 'undo' to
+	set buffer-read-only temporarily to t.
+	(slime-repl-return): Only send repl input if point is past a
+	complete form.
+
+2006-05-12  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (update-indentation-information): Fix for problem
+	with Allegro CL 8.0: If I type M-x slime-update-indentation,
+	Allegro CL starts growing until it hits a STORAGE-CONDITION or
+	even segfaults.
+
+2006-05-04  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-allegro.lisp (fspec-definition-locations): Handle
+	:top-level-form entries that appear in backtraces.
+
+2006-04-20  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (toggle-trace): Implemented. Currently only
+	provides 'best effort' support, :labels and :flet are ignored,
+	:defmethod and :call are treated like a normal trace of the
+	operator.
+
+2006-04-20  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*use-dedicated-output-stream*): Make it nil by
+	default to avoid race conditions.
+
+2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
+
+	* doc/Makefile (contributors.texi): use texinfo macros for
+	accented characters.
+
+	* ChangeLog: canonize Gabor Melis' spelling, otherwise he appears
+	twice in the "Hackers of the good Hack table"
+
+	* doc/slime.texi (nyorsko): delete
+	(EDITION): make it say 2.0
+	
+2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
+
+	* swank.lisp (decoded-arglist-to-string): if the keyword and the
+	variable are different, print the keyword name with escapes.
+	(encode-keyword-arg): get the keyword and the arg-name the same
+	way round as in lambda lists.
+	(appliable-methods-keywords): use
+	swank-mop:compute-applicable-methods-using-classes and
+	compute-applicable-methods in the AMOP-friendly way, to get EQL
+	specializers right.
+	(class-from-class-name-form, extra-keywords/slots): new.
+	(extra-keywords/make-instance): use new functions.  Also get
+	keywords from SHARED-INITIALIZE (after Dan Barlow) and
+	ALLOCATE-INSTANCE.
+	(extra-keywords/change-class): new.
+	(extra-keywords (eql 'change-class)): new.  Won't work at present,
+	just as the CERROR case doesn't work.
+	
+2006-04-19  Christophe Rhodes <csr21 at cam.ac.uk>
+
+	* swank-sbcl.lisp (preferred-communication-style): Make it nil
+	under win32, for now.
+
+	* doc/slime.texi: document nil *communication-style*
+
+2006-04-18  Espen Wiborg  <espenhw at grumblesmurf.org>
+
+	* swank-corman.lisp: Define a class file-stream to let swank.lisp
+	load.
+
+2005-04-17  Andras Simon <andras at renyi.hu>
+
+	* swank-abcl.lisp: (accept-connection): New argument: timeout.
+
+2006-04-14  Gerd Flaig <gefla at pond.sub.org>
+
+	* slime.el (slime-autodoc): Fix reference to unbound variable.
+
+2006-04-13  Martin Simmons <martin at lispworks.com>
+
+	* swank-loader.lisp (load-site-init-file, swank-source-files): Fix
+	pathname construction to take all unspecified components from the
+	directory pathname, in particular the drive letter on Windows.
+
+2006-04-13  Helmut Eller  <helmut at common-lisp.net>
+
+	* slime.el (slime-find-filename-translators): Use assoc-if instead
+	of assoc-default for XEmacs compatibility.
+	(slime-show-note-counts): Don't show the highlighting bit as it
+	spills of the screen.
+	(slime-highlight-notes): Use with-temp-message.
+	(with-temp-message): Define it for XEmacs.
+	(slime-beginning-of-symbol): Use eq instead of char-equal as
+	char-equal signals an error at the beginning of a buffer.
+	
+2006-04-13  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl (make-socket-io-stream): set the stream to ignore
+	character conversion errors, and to substitute the character #\?.
+	Without this the communication channel is prone to lockup when a
+	conversion error occurs.
+
+	* swank-scl (inspect-for-emacs function): correct the index into the
+	closure environment; it was reading off the end of the closure
+	environment and picking up a corrupting value.
+
+	* swank-scl (mailbox): rework the mailbox implementation to better
+	handle interruption.  Use a polling loop rather than condition
+	variables because interrupting a condition variable wait leaves the
+	thread with the condition variable lock held and leads to a deadlock
+	error.
+
+2006-04-12  Robert Macomber <slime at rojoma.com>
+
+	* swank-backend.lisp (make-recursive-lock): New interface
+	function.
+	(call-with-recursive-lock-held): New interface function. 
+	
+	* swank-grey.lisp (class slime-output-stream): Added recursive
+	locking to class and generic functions specialized on it.
+	(clss slime-input-stream): Added recursive locking to class and
+	generic functions specialized on it.
+
+	* swank-sbcl.lisp (make-recursive-lock): Implement the new interface.
+	(call-with-recursive-lock): Implement the new interface.
+		
+2006-04-01  Matthew D. Swank <akopa at charter.net>
+
+	* slime.el (slime-fontify-string): Use set-text-properties, not
+	propertize, for Emacs 20 compatibility.
+
+2006-03-30  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-init-command): Don't translate filenames since
+	the new scheme doesn't work without a connection.
+	(slime-to-lisp-filename,slime-from-lisp-filename): Remove some
+	redundancy.
+	(slime-macroexpansion-minor-mode): Make it Emacs 20 compatible.
+
+2006-03-29  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-repl-mode): Enable autodoc-mode if
+	slime-use-autodoc-mode is true.
+
+2006-03-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (multiple-value-or): New macro.
+
+	* slime.el (slime-recently-visited-buffer): Ignore internal
+	buffers (starting with a space), to avoid selecting the
+	*slime-fontify* buffer.  Reported by Andreas Fuchs.
+
+	* slime.el (slime-enclosing-operator-names): Handle forms similar
+	to make-instance (make-condition, error, etc.), to get extra
+	keywords based on the condition class.
+
+	* swank.lisp (operator-designator-to-form): Handle forms similar
+	to make-instance (make-condition, error, etc.)
+	(extra-keywords/make-instance): New function.
+	(extra-keywords): Specialize on operators make-condition, error,
+	signal, warn, cerror.  Use multiple-value-or.
+
+2006-03-27  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-make-tramp-file-name): If emcas' tramp has
+	tramp-multi-methods then pass the method parameter to
+	tramp-make-tramp-file-name, otherwise don't.
+	(slime-create-filename-translator): Use
+	slime-make-tramp-file-name.
+
+2006-03-27  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* hyperspec.el (common-lisp-hyperspec-strip-cl-package): New
+	function.
+	(common-lisp-hyperspec): Don't get confused by a cl: or
+	common-lisp: package prefix.
+
+	* slime.el (slime-hyperspec-lookup): Don't get confused by a cl:
+	or common-lisp: package prefix.
+
+2006-03-26  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-enclosing-operator-names): Fix for situation
+	when point is at end of buffer, as it happens often in the REPL.
+
+2006-03-25  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (arglist-for-echo-area): New keyword arg,
+	print-lines.
+	(decoded-arglist-to-string): New function, implement argument
+	highlighting also for &optional and &rest/&body arguments.
+	(arglist-to-string): Use decoded-arglist-to-string.
+	(arglist): New slots aux-args, known-junk, unknown-junk.
+	(nreversef): New macro.
+	(decode-arglist, encode-arglist): Refine to handle more structure
+	in argument lists, including implementation-defined stuff like
+	&parse-body.
+	(format-arglist-for-echo-area): New keyword arg, print-lines.
+	Simplify the code as there is no need to fall back to the unparsed
+	arglist any more.
+
+	* slime.el (slime-fontify-string): Fix for arguments spanning
+	multiple lines.
+	(slime-autodoc-message-dimensions): New.
+	(slime-autodoc-thing-at-point): Use it here to either ask for a
+	one-line or a nicely formatted multi-line arglist.
+	(slime-enclosing-operator-names): Handle linebreaks.
+
+2006-03-24  Mikel Bancroft <mutandiz at yahoo.com>
+
+	* swank-allegro.lisp (set-default-directory): Fix for pathnames
+	without a trailing slash.
+
+2006-03-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-background-activities-enabled-p): Allow
+	"background activities" in sldb-mode.
+	(slime-autodoc-message-ok-p): Allow autodoc in sldb-mode.
+	(sldb-mode-syntax-table): New variable.
+	(sldb-mode): Enable autodoc-mode when slime-use-autodoc-mode is
+	true.  Use sldb-mode-syntax-table to make #<...> balance like
+	parentheses.  This enables autodoc-mode to match #<unreadable>
+	actual arguments in the backtraces with formal arguments of the
+	function.
+	(slime-beginning-of-symbol, slime-end-of-symbol): Handle
+	es::|caped| symbols.
+	(slime-enclosing-operator-names): Use syntax table to check
+	whether we are at the beginning of a balanced expression.
+
+2006-03-23  Christophe Rhodes <csr21 at cam.ac.uk>
+
+	* swank.lisp (ed-in-emacs): Allow conses as function names.
+	Ensure that there is a connection to emacs before sending the
+	:ed message.
+
+	* slime.el (slime-edit-definition): read names, not symbols.
+	(slime-ed): handle conses whose car is not a string as function
+	names.
+
+2006-03-23  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-qualify-cl-symbol-name): Strip leading colon
+	from package names for qualifying symbols.
+	(slime-call-defun): New command.
+	(slime-keys): Bind it to C-c C-y.
+	(slime-easy-menu): Show it in the menu.
+
+	* slime.el (slime-autodoc-use-multiline-p): New defcustom.
+	(slime-autodoc-message): Use it here.  Fix bug that autodoc
+	messages exceeding one line could not be overwritten by later
+	autodoc messages.
+	(slime-autodoc-pre-command-refresh-echo-area): Use message
+	rather than slime-background-message.
+	
+	* swank.lisp (casify): Removed.
+	(casify-char, tokenize-symbol-thoroughly): New functions.
+	(parse-symbol): Use tokenize-symbol-thoroughly, so as to handle
+	|escaped symbols|.  This fixes arglist display for operators with
+	strange symbol names.
+
+2006-03-23  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-backend (accept-connection): add a 'timeout argument to
+	this function.
+
+	* swank-backend (set-stream-timeout): new implementation specific
+	function.  Used to set the timeout for stream operations, which
+	can help make the network connection establishment more robust.
+
+	* swank (setup-server): ignore errors from the function 'serve to
+	allow another connection to be made.
+
+	* swank (serve-connection): ensure the listener socket is closed
+	when 'dont-close is false, even if the connection attempt fails.
+
+	* swank (accept-authenticated-connection): ensure the new
+	connection is closed if the connection establishment fails.  Set a
+	short stream timeout to prevent denial of survice.
+
+	* swank (open-dedicated-output-stream): ensure the listener socket
+	is closed, even if unable to open the dedicated stream.  Implement
+	a timeout while waiting for a connection for the dedicate stream
+	to prevent denial of service.
+
+	* swank (create-connection): ensure the new connection is closed
+	if not successful.
+
+2006-03-22  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (arglist-for-echo-area): Fix when arg-indices are
+	not given.
+
+	* slime.el (slime-ed): Handle (FILENAME :charpos CHARPOS). 
+
+	* swank.lisp (inspect-for-emacs): Specialize on FILE-STREAM and
+	STREAM-ERROR, offering to visit the file at the current stream
+	position as an inspector action.  Useful for dealing with reader
+	errors. 
+
+2006-03-20  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-autodoc-pre-command-refresh-echo-area): 
+	Show the last autodoc message again (movement commands clear it);
+	technique to avoid flickering, taken from eldoc.
+	(slime-autodoc-mode): Install it as a pre-command-hook.
+	(slime-autodoc-last-message): New variable.
+	(slime-autodoc-message): New function.
+	(slime-autodoc): Use them here.
+	(slime-autodoc-message-ok-p): OK to overwrite an autodoc message.
+
+	* slime.el (slime-handle-indentation-update): Also update
+	scheme-indent-function if slime-lisp-modes contains scheme-mode.
+
+2006-03-19  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Highlight the formal argument corresponding to the actual
+	argument around point in the echo-area arg-list display.
+	Works most impressively when slime-autodoc-mode is enabled
+	and when one has to deal with extremely long argument lists.
+	
+	* slime.el (slime-space): First insert the space, then obtain
+	information.
+	(slime-fontify-string): Also handle argument highlights.
+	(slime-enclosing-operator-names): As a secondary value, return a
+	list of the indices of the arguments to the nested operator.
+	(slime-contextual-completions): Use changed interface of
+	slime-enclosing-operator-names.
+	(slime-function-called-at-point): Removed.
+	(slime-function-called-at-point/line): Removed.
+	(slime-autodoc-thing-at-point): New.
+	(slime-autodoc): Re-implement with slime-enclosing-operator-names
+	instead of slime-function-called-at-point.
+	(slime-echo-arglist): Pass the argument indices to
+	arglist-for-echo-area.
+	(slime-autodoc-message-ok-p): Autodoc is also OK in REPL buffers.
+
+	* swank.lisp (arglist-for-echo-area): New keyword argument
+	arg-indices. 
+	(arglist-to-string): New keyword argument highlight.
+	(format-arglist-for-echo-area): Likewise.
+
+2006-03-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-goto-location-buffer): Avoid calling the
+	expensive function find-file-noselect when we are already in the
+	right buffer.  
+
+	* swank.lisp (arglist-for-echo-area): Add keyword argument
+	print-right-margin. 
+	(arglist-to-string, format-arglist-for-echo-area): Likewise.
+	* slime.el (slime-autodoc): Use it here to make use of the whole
+	width of the echo area for arglist display.
+
+2006-03-16  Gábor Melis <mega at hotpop.com>
+
+	* swank-allegro.lisp (inspect-for-emacs): Fix typo.
+
+2006-03-16  Gary King <gwking at metabang.com>
+
+	* swank-loader.lisp (lisp-version-string): Modified swank-loader
+	so that Allegro's alisp and mlisp programs get different
+	locations. Otherwise mlisp complains about alisp's files.
+
+2006-03-16  Marco Baringer <mb at bese.it>
+
+	* slime.el (slime-to-lisp-filename): Call expand-file-name before
+	passing the filename to the to-lisp function.
+
+2006-03-14  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-system-history): New variable.
+	(slime-read-system-name): Use a separate history list for ASDF
+	system names.
+	(slime-note-counts-message): New variable.
+	(slime-show-note-counts): Store the note counts message for later use.
+	(slime-highlight-notes, slime-list-compiler-notes): Show a
+	progress message, keeping note counts visible.
+	(slime-find-buffer-package): Handle IN-PACKAGE forms that appear
+	in SWIG/Allegro CL wrappers.
+
+	* swank-allegro.lisp (compile-from-temp-file): Suppress Allegro's
+	redefinition warnings; they are pointless when we are compiling
+	via a temporary file.
+	(profile-report): Implement.
+
+2006-03-06   Nathan Bird <nathan at acceleration.net>
+ 
+	* slime.el (slime-create-filename-translator): use the tramp
+	methods for dissecting and building filenames.
+
+2006-03-04  Wojciech Kaczmarek <wojtekk at kofeina.net>
+
+	* slime.el (slime-filename-translations): Typo in example.
+	(slime-create-filename-translator): Typo in generated lambdas.
+
+2006-03-03  Marco Baringer  <mb at bese.it>
+
+	Allow per-host (per machine-instance actually) filename
+	translation functions.
+	
+	* slime.el (slime-translate-to-lisp-filename-function): removed.
+	(slime-translate-from-lisp-filename-function): removed.
+	(slime-filename-translations): New variable.
+	(slime-to-lisp-filename): Rewrote to search through available
+	transalations.
+	(slime-from-lisp-filename): idem.
+	(slime-create-filename-translator): New function.
+	(slime-add-filename-translation): New function.
+
+2006-02-27  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-eval-macroexpand-inplace): Indent the inserted
+	macroexpansion. 
+
+2006-02-27  Marco Baringer  <mb at bese.it>
+
+	Provide functions for performing macroexpansion inplace, use these
+	functions in the *SLIME macroexpansion* buffer.
+	
+	* slime.el (slime-macroexpansion-minor-mode): Attempt to map
+	-inplace functions to the same keys as their regular contureparts
+	in slime-mode-map.
+	(slime-eval-macroexpand-inplace): New function.
+	(slime-macroexpand-1-inplace): New function.
+	(slime-macroexpand-all-inplace): New function.
+	* doc/slime.texi: Document new macroexpansion mode.
+
+2006-02-26  Douglas Crosher <dcrosher at common-lisp.net>
+	* swank-scl.lisp: (ext:stream-read-chars):  Correct the updating of
+	the buffer index.  Fixes slime input stream problems.
+
+2006-02-25  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-loader.lisp (default-fasl-directory): Previously we return
+	only the directory-namestring which breaks SCL, because it loses
+	the host and device components.  Return the complete pathname
+	instead.  Patch by Douglas Crosher.
+
+	* slime.el (slime-lisp-host): New variable. Replace all references
+	to "127.0.0.1" with the variable.
+
+2006-02-25  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-backend.lisp (operate-on-system): symbol case fix for
+	SCL's lowercase mode.
+
+	* swak.lisp (setup-stream-indirection)
+	(globally-redirect-io-to-connection)
+	(revert-global-io-redirection): symbol case fixes.
+	
+	* swank-scl.lisp: (inspect-for-emacs):  Fixes for the inspect
+	standard-objects, and inspect array.  Plus misc symbol case fixes.
+
+2006-02-22  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-repl-send-input): Don't include the final
+	newline in the slime-repl-input-face overlay, thus avoid showing the
+	"Evaluation aborted" message in boldface.  Don't set non-existent
+	"rear-nonsticky" overlay property; overlay stickiness is
+	controlled by make-overlay arguments. 
+
+2006-02-20  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Use argument list information to complete keywords contextually. 
+	Example:  (find 1 '(1 2 3) :s <M-TAB> --completes--> :start 
+	rather than suggesting all ever-interned keywords starting with ":s".
+	
+	* slime.el (slime-complete-keywords-contextually): New
+	customizable variable.
+	(slime-enclosing-operator-names): New optional argument
+	max-levels. 
+	(slime-completions-for-keyword): New.
+	(slime-contextual-completions): New.
+	(slime-expand-abbreviations-and-complete): Use it instead of
+	slime-completions. 
+
+	* swank.lisp (operator-designator-to-form): New, factored out from
+	arglist-for-echo-area.
+	(arglist-for-echo-area): Use it here.
+	(completions-for-keyword): New.
+	(find-matching-symbols-in-list): New.
+
+2006-02-19  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-expand-abbreviations-and-complete): Scroll the
+	completions buffer if the TAB key is pressed another time, like
+	Emacs minibuffer completion does.
+
+2006-02-18  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-macroexpansion-minor-mode): New minor mode for
+	macroexpansion buffer. Exactly like slime-temp-buffer-mode but
+	with slime-macroexpand-again bound to "g".
+	(*slime-eval-macroexpand-expression*): New variable. introduced
+	for slime-macroexpand-again, used by slime-eval-macroexpand as
+	well.
+	(slime-eval-macroexpand): Added optional string argument which
+	defaults to (slime-sexp-at-point-or-error).
+	(slime-macroexpand-again): New function, redoes the last
+	macroexpansion.
+	(slime-sexp-at-point-or-error): New function. Like
+	slime-sexp-at-point but signals an error when slime-sexp-at-point
+	would return nil.
+	* swank-openmcl.lisp (swank-mop:compute-applicable-methods-using-classes): 
+	Implement.
+ 
+2006-02-16  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* sbcl-pprint-patch.lisp: New file, adds the annotations feature
+	to the SBCL pretty printer.  This is needed for sending
+	presentations through pretty-printing streams.
+	* present.lisp [sbcl]: Load it here.
+	(slime-stream-p, write-annotation) [sbcl]: Handle pretty-streams.
+
+2006-02-10  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp, swank-lispworks.lisp (inspect-for-emacs):
+	Use the backend specific method to inspect standard-objects
+	because {slot-boundp,slot-value}-using-class don't conform to the
+	MOP spec in LW and ACL.
+
+	* swank.lisp (macro-indentation): Don't count '&optional as
+	argument.
+
+	* swank-loader.lisp (default-fasl-directory): Include the SLIME
+	version.
+	(slime-version-string): New.
+
+2006-02-06  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Show enriched arglists for DEFMETHOD in the echo area when the
+	user types SPC after the generic function name.
+	
+	* swank.lisp (arglist-to-template-string): Unused, removed.
+	(extra-keywords): Indicate which part of the actual arglist was
+	used to determine the extra keywords.  For MAKE-INSTANCE, don't
+	signal an error if the class does not exist.
+	(enrich-decoded-arglist-with-extra-keywords): Indicate which part
+	of the actual arglist was used to determine the extra keywords,
+	and whether any extra keywords were added.
+	(form-completion): Generalize to handle display of enriched formal
+	arglists.
+	(read-incomplete-form-from-string): New, factored out from
+	complete-form.  Handle end-of-file.
+	(complete-form): Use it here.
+	(format-arglist-for-echo-area): Use form-completion, so as to
+	show enriched formal arglists for MAKE-INSTANCE and DEFMETHOD
+	calls. 
+	(arglist-for-echo-area): Handle MAKE-INSTANCE and DEFMETHOD
+	calls. 
+
+	* slime.el (slime-enclosing-operator-names): Represent
+	MAKE-INSTANCE calls by (:make-instance "CLASS-NAME"), handle
+	DEFMETHOD too.
+
+2006-02-05  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-complete-form): Indent the inserted template.
+
+2006-02-04  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-fontify-string): New.
+	(slime-echo-arglist, slime-arglist, slime-autodoc): Use it here to
+	fontify echo-area arglists.
+
+2006-02-02  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp: Added imports for slot-boundp-using-class,
+	slot-value-using-class and finalize-inheritance.
+	
+2006-02-01  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* swank-abcl.lisp: define with-compilation-hooks (= funcall for now), so that you can do slime-oos
+	
+2006-01-30  Ian Eslick <eslick at csail.mit.edu>
+
+        Show slot values for metaclasses that override the default storage
+	locations for objects slots (i.e. where the default slot-boundp
+	returns nil) in the inspector.
+	
+	* swank.lisp (inspect-for-emacs standard-object): Use
+	slot-value-using-class and slot-boundp-using-class.
+
+	* swank-backend.lisp: Add slot-value-using-class and
+	slot-boundp-using-class to the swank-mop package.
+	
+2006-01-26  Luís Oliveira <loliveira at common-lisp.net>
+
+	* slime.el (slime-enclosing-operator-names): detect make-instance
+	forms and collect the class-name argument if it exists and is a
+	quoted symbol.
+
+	* swank.lisp (arglist-for-echo-area): handle pairs of of the form
+	("make-instance" . "<class-name>") by passing them to
+	format-initargs-and-initforms-for-echo-area.
+	(class-initargs-and-iniforms): New function.
+	(format-initargs-and-initforms-for-echo-area): New function.
+
+2006-01-20  Mészáros Levente <melevy at freemail.hu>
+
+	* swank-sbcl.lisp (restart-frame): Provide an implementation even
+	if it doesn't quite do what it's supposed to do.
+
+2006-01-19  Helmut Eller  <heller at common-lisp.net>
+
+	Return to the previous loading strategy: load everything when
+	swank-loader is loaded.  It's just to convenient to give that up.
+	To customize the fasl directories, the new variable
+	swank-loader:*fasl-directory* can be set before loading
+	swank-loader.
+	
+	* swank-loader.lisp (*fasl-directory*, *source-directory*): New
+	variables.
+	(load-swank): Call it during loading.
+
+2006-01-14  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-compile-defun): If point was at the opening
+	paren we wrongly used the preceding toplevel form.  Fix it.
+	Reported by Chisheng Huang and Liam M. Healy.
+
+	* swank.lisp (spawn-threads-for-connection): Fix a race condition:
+	Don't accept input before all threads are ready.
+
+	Make the fasl directory customizable: load-swank must now be
+	called explicitly so that we can supply the fasl dir as argument.
+	
+	* swank-loader.lisp (load-swank): New entry point.
+	
+2006-01-14  Andreas Fuchs <asf at boinkor.net>
+
+	* slime.el (slime-selector ?r): Call slime instead of slime-start
+	to pick up the usual defaults.
+
+2005-12-31  Harald Hanche-Olsen <hanche at math.ntnu.no>
+
+	* slime.el (slime-open-stream-to-lisp): Inherit the
+	process-coding-system from the current connection.
+
+2005-12-27  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* swank-abcl. (backtrace-as-list-ignoring-swank-calls): remove the
+	swank calls from the backtrace to make it easier to use.
+	(frame-locals): Fix a typo that caused entry into the debugger if
+	you tried to look at frame locals. Now you don't error out, but
+	you still don't see frame locals because I don't know how to get
+	them :(
+
+2005-12-27  Helmut Eller  <heller at common-lisp.net>
+
+	Keep a history of protocol events for better bug reports.
+	
+	* swank.lisp (log-event): Record the event in the history buffer.
+	(*event-history*): Buffer for events.
+	(dump-event-history): New function.
+	(close-connection): Escape non-ascii strings and include the event
+	history in the error message.
+
+2005-12-22  Helmut Eller  <heller at common-lisp.net>
+
+	Make highlighting of modified text a minor mode. Also use
+	after-change-functions instead of rebinding all self-inserting
+	keys.
+	
+	* slime.el (slime-highlight-edits-mode): New minor mode.
+	(slime-self-insert-command): Deleted.
+	(slime-before-compile-functions): New hook to decouple edit
+	highlighting from compilation.
+	(slime-highlight-edits-face): Renamed from slime-display-edit-face.
+
+2005-12-20  Marco Baringer  <mb at bese.it>
+
+	When inspecting classes, methods and generic functions show all
+	the slots in the case that what we're inspecting is a subclass of
+	the standard class and has extra user defined slots.
+	
+	* swank.lisp (all-slots-for-inspector): New function.
+	(inspect-for-emacs): Use all-slots-for-inspector.
+
+2005-12-19  Peter Seibel  <peter at gigamonkeys.com>
+
+	* slime.el (slime-self-insert-command): Got rid of message about
+	setting up face and skipping edit-hilights when in a comment.
+
+2005-12-18  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* slime.el (slime-mode-hook): Bind simple characters to
+	slime-self-insert-command only if there was no previous local
+	binding, and the major mode is _not_ slime-repl-mode. This
+	restores keybindings of slime-xref-mode and prevents us from
+	stomping on user bindings. The hilighting also makes no sense in
+	the REPL.
+
+2005-12-16  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* slime.el (slime-selector-method: ?r): If no connection offer to
+	start Slime.
+	
+	* swank.lisp (to-string): Handle errors from printing objects.
+	Among other things makes the inspector more robust in the face of
+	objects with unbound slots and print-methods that fail to cope.
+
+2005-12-16  William Bland <doctorbill.news at gmail.com>
+
+	Added hilighting of tetx which has been edited but not yet
+	compilied.
+
+	* slime.el (slime-display-edit-hilights): New variable.
+	(slime-display-edit-face): New face.
+	(slime-compile-file, slime-compile-defun, slime-compile-region):
+	Remove edits overlay.
+	(slime-remove-edits): New function.
+	(slime-self-insert-command): New function.
+	(slime-mode-hook): Rebind simple characters to
+	slime-self-insert-command.
+
+2005-12-07  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-allegro.lisp (find-definition-in-file)
+	(find-fspec-location, fspec-definition-locations): Allegro CL
+	properly records all definitions made by arbitrary macros whose
+	names start with "def".  Use excl::find-source-file and
+	scm:find-definition-in-definition-group (rather than
+	scm:find-definition-in-file) to find them.
+
+	* slime.el (slime-load-file): Change the default to be the buffer
+	file name with extension.  This is more convenient for files like
+	.asd files that do not have the default source file extension.
+	(slime-save-some-lisp-buffers, slime-update-modeline-package):
+	Handle all files with major mode in slime-lisp-modes, not just
+	lisp-mode.
+
+2005-12-06  Juho Snellman <jsnell at iki.fi>
+
+	* swank-sbcl.lisp (function-source-location,
+	safe-function-source-location): Oops, define these functions also
+	for the >0.9.6 case. Fixes broken sldb-show-source on SBCL 0.9.7.
+
+2005-12-05  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-find-coding-system): Use check-coding-system
+	only if it's actually fbound.
+
+2005-11-22  Marco Monteiro <masmxx at gmail.com>
+
+	* slime.el (slime-connect): Use slime-net-coding system if the
+	optional arg coding-system was not supplied.
+	
+2005-11-22  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-compile-file): Call 'check-parens before
+	compiling.
+	(slime-compile-file): Call 'check-parens before compiling.
+	(slime-find-coding-system): Return nil if the coding system
+	isn'tvalid instead of singalling an error.
+	(slime-repl-history-file-coding-system): Use
+	slime-find-coding-system to find the default.
+
+	* swank-cmucl.lisp (accept-connection): Remove fd-handlers if the 
+	encoding isn't iso-latin-1.
+	
+2005-11-21  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-start): Don't set slime-net-coding-system ..
+	(slime-read-port-and-connect): .. read it from the inferior lisp args.
+	(slime-connect): Take the coding-system as third argument.
+	(slime-repl-history-file-coding-system): New user option.
+	(slime-repl-safe-save-merged-history): New function.  Use it in
+	hooks so that bad coding systems don't stop us from exiting.
+	(slime-repl-save-history): Include the coding-system which was
+	used to save the buffer.
+	(repl-shoctut change-package): Add alias ,in and ,in-package.
+	(slime-eval-macroexpand): Error out early if there's no sexp at
+	point.
+	(slime-compiler-macroexpand): New command.
+	(slime-inspector-pprint): New command.
+
+	* swank-cmucl.lisp (inspect-for-emacs): Add support for
+	funcallable instances.
+
+	* swank.lisp (pprint-inspector-part, swank-compiler-macroexpand): New. 
+
+	* swank-backend.lisp (compiler-macroexpand)
+	(compiler-macroexpand-1): New functions.
+
+2005-11-14  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl.lisp (accept-connection): handle the :buffering argument.
+
+2005-11-13  Andras Simon <andras at renyi.hu>
+
+	* swank-abcl.lisp: (accept-connection): New argument: buffering.
+
+2005-11-13  Andras Simon <andras at renyi.hu>
+
+	* swank-abcl.lisp: Steal auto-flush stuff from swank-sbcl.lisp
+
+2005-11-11  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*dedicated-output-stream-buffering*): New variable
+	to customize the buffering scheme.  For single-threaded Lisps we
+	disable buffering because lazy programmers forget to call
+	finish-output.
+	(open-dedicated-output-stream): Use it.
+
+	* swank-backend.lisp, swank-allegro.lisp, swank-lispworks.lisp,
+	swank-openmcl.lisp, swank-cmucl.lisp, swank-sbcl.lisp,
+	swank-clisp.lisp, swank-abcl.lisp, swank-corman.lisp,
+	swank-ecl.lisp (accept-connection): New argument: buffering.
+
+	* slime.el (slime-repl-save-history): When the history exceeds
+	slime-repl-history-size remove the old not the new entries.  
+	Some renaming: 
+	slime-repl-read-history -> slime-repl-load-history,
+	slime-repl-read-history-internal -> slime-repl-read-history.
+	(slime-eval-macroexpand): Call font-lock-fontify-buffer
+	explicitly, because with certain Emacs versions the buffer doesn't
+	get fontified immediately.
+
+2005-11-07  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-eval-macroexpand): Use lisp-mode (and
+	font-lock-mode) when dispaying the expansion.  Suggested by Jan
+	Rychter.
+
+	* swank-source-path-parser.lisp (make-source-recording-readtable):
+	Suppress the #. reader-macro.
+
+2005-11-06  Juho Snellman <jsnell at iki.fi>
+
+	* swank-sbcl.lisp (find-definitions, make-source-location-specification
+          make-definition-source-location, source-hint-snippet): As of
+          SBCL 0.9.6.25 SB-INTROSPECT has better support for finding 
+          source locations. Use as much of it in swank-sbcl as possible.
+          (Original version left reader-conditionalized for older SBCLs).
+
+2005-11-04  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (connection-info): Docfix.
+
+	* slime.el (slime-set-connection-info): Generate a new connection
+	name only if the implementation-name and the inferior-lisp-name
+	are different.
+
+2005-10-31  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-start, slime-lookup-lisp-implementation)
+	(slime-set-connection-info): Add a :name property for the
+	implementation and use it to derive the connection-name.
+	(slime-lisp-implementation-name): Renamed from
+	slime-lisp-implementation-type-name.
+
+	* swank.lisp (simple-serve-requests): Add an extra abort restart.
+	(connection-info): Rename :type-name to :name.
+	
+2005-10-30  Andras Simon <andras at renyi.hu>
+
+	* swank-abcl.lisp (inspect-for-emacs): Track mop changes in ABCL.
+
+2005-10-30  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-eval): Ensure that the connection is open before
+	waiting for input.
+
+	* swank.lisp (simple-serve-requests): Close the connection at the
+	end.
+
+2005-10-23  Harald Hanche-Olsen <hanche at math.ntnu.no>
+
+	* slime.el (slime-init-keymaps): Use vectors when defining keys,
+	because e.g. (define-key (string ?\C-c) ...) doesn't work in the
+	emacs-unicode-2 branch.
+
+2005-10-23  Stefan Kamphausen <skampi at gmx.net>
+
+	* slime.el (slime-repl-history-size, slime-repl-history-file): Use
+	defcustom to declare the variables.
+	
+2005-10-23  Gábor Melis  <mega at hotpop.com>
+ 
+	* swank-backend.lisp (install-debugger-globally): new interface
+	function
+ 
+	* swank.lisp (install-debugger): call install-debugger-globally
+ 
+	* swank-sbcl.lisp (install-debugger-globally): set
+	sb-ext:*invoke-debugger-hook* too
+	
+2005-10-23  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (make-stream-interactive): Spawn a thread to
+	flush interactive streams in reasonably short intervals.  
+	Remove the old backward-compatible threading implementation.
+
+	* swank.lisp (package-string-for-prompt): Respect *print-case*.
+
+2005-10-21  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-start-swank-server): Avoid comint-send-input
+	here as it seems to trigger a bug in ansi-color-for-commit-mode.
+
+2005-10-18  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank.lisp (canonical-package-nickname): always return the
+	package name as a STRING if found.  This restores the printing of
+	package names as strings.
+
+2005-10-17  Marco Baringer  <mb at bese.it>
+	
+	* swank.lisp (eval-in-emacs): Instead of taking a string and
+	attempting to parse it emacs side the function now takes a form
+	and converts it to a string internally. This should allow users of
+	the function to not have to worry about quoting issues and emacs'
+	different printed represenation for, among other things,
+	characters.
+	(process-form-for-emacs): New function. Converts a list into a
+	string for passing to emacs.
+
+	* slime.el (slime-eval-for-lisp): New API. This function now takes
+	a single string, representing the form to evaluate, and uses
+	emacs' read function to convert it into a form before eval'ing it.
+	(slime-dispatch-event): The :eval event now passes a single
+	string (instead of a string and something looking kind of like a
+	form).
+
+2005-10-15  Douglas Crosher <dcrosher at common-lisp.net>
+
+	* swank-scl.lisp: Support for Scieneer Common Lisp.
+
+	* swank-backend.lisp (*gray-stream-symbols*) Scieneer Common Lisp
+	implements stream-line-length.
+
+	* swank-loader.lisp: Support for Scieneer Common Lisp:
+	(*sysdep-pathnames*) use swank-scl.
+	(*impl ementation-features*) add :scl.
+	(*os-features*) add :hpux.
+	(*architecture-features*) add :amd64, :i686, :i486, :sparc64, :sparc,
+	   :hppa64, and :hppa.
+
+	* swank.lisp: (*canonical-package-nicknames*) use lowercase
+	symbols to name the packages.  This supports CL implementations
+	with lowercase default symbol names, such as Scieneer Common Lisp,
+	while still being compatible with ANSI-CL.
+
+2005-10-11  Stefan Kamphausen <skampi at gmx.net>
+
+	* slime.el: Persistent REPL history.  The history from REPL
+	buffers is now saved to the file ~/.slime-history.eld.  The file
+	is read on startup and saved when a REPL buffer gets killed or
+	when Emacs exits.  There are also commands to save or read the
+	history file.
+	(slime-repl-save-merged-history, slime-repl-merge-histories)
+	(slime-repl-read-history, slime-repl-save-history): New functions.
+	(slime-repl-history-file, slime-repl-history-size): New vars.
+	(slime-repl-mode): Add hooks to load and save the history.
+	
+2005-10-11  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-read-interactive-args): Split the string
+	inferior-lisp-program to get the values for :program and
+	:program-args.  Also let slime-lisp-implementations take
+	precedence if non-nil.
+	(slime-lisp-implementations): Renamed from
+	slime-registered-lisp-implementations.
+
+	* swank.lisp (force-user-output): There seems to be a bug in
+	Allegro's two-way-streams. As a workaround we use force-output for
+	the user-io stream.  (finish-output *debug-io*) still triggers the
+	bug.
+
+2005-10-10  Svein Ove Aas  <svein.ove at aas.no>
+
+	* swank-allegro.lisp (find-external-format): Translate :utf-8-unix
+	to :utf8, which Allegro 7.0 understands.
+
+2005-10-09  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime, slime-start): Introduce a separate function for
+	the non-interactive case.  `slime-start' takes lots of keyword
+	arguments and `slime' is reserved for interactive use.  
+	(slime-read-interactive-args): New function.
+	(slime-maybe-start-lisp, slime-inferior-lisp)
+	(slime-start-swank-server): Pass all arguments needed to start
+	the subprocess as a property list.  Also store this list in a
+	buffer-local var in the inferior-lisp buffer, so that we can
+	cleanly restart the process.
+	(slime-registered-lisp-implementations): Change the format and
+	document it.  M-- M-x slime can now be used select a registered
+	implementation.
+	(slime-symbolic-lisp-name): Deleted. And updated all the functions
+	which passed it along.  
+	(slime-set-connection-info): Use the new format.
+	(slime-output-buffer): Don't re-initialize buffer-local variables
+	if the buffer already exists.  This saves the history. From Juho
+	Snellman.
+
+	* swank-cmucl.lisp (sis/in): Use finish-output instead of
+	force-output.
+
+	* swank.lisp (connection-info): Include the initial package and
+	a more self-descriptive format.
+
+2005-10-01  Juho Snellman  <jsnell at iki.fi>
+
+	* swank-backend (*gray-stream-symbols*): Add :STREAM-LINE-LENGTH
+        to *GRAY-STREAM-SYMBOLS* on implementations that support this
+        extension to gray streams. Reported by Matthew D Swank.
+
+2005-09-29  Luke Gorrie  <luke at synap.se>
+
+	* swank-scheme48: Removed due to excessive whining.
+
+2005-09-28  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-multiprocessing): Deleted. No longer needed.
+	(slime-init-command): Updated accordingly.
+	(slime-current-package): Add a special case for Scheme.
+	(slime-simple-completions, slime-apropos): Quote the package,
+	because in can be a plain symbol in Scheme.
+	(slime-inspector-reinspect): Use a proper defslimefun.
+
+	* swank.lisp (inspector-reinspect): New function.
+	(start-server): Call initialize-multiprocessing before starting
+	the server and startup-idle-and-top-level-loops afterwards.
+	Calling startup-idle-and-top-level-loops here shouldn't be a
+	problem because start-server is only invoked at startup via stdin.
+
+	* swank-scheme48/source-location.scm: New file. For M-.
+	* swank-scheme48/module.scm (list-all-package): New function.
+	* swank-scheme48/interfaces.scm (module-control-interface): Export it.
+	* swank-scheme48/inspector.scm: Add methods for records and hashtables.
+	(swank:arglist-for-echo-area): Implement it.  Only works for
+	functions with enough debug-data (ie. only user-defined functions).
+	* swank-scheme48/completion.scm: New file.
+	(swank:simple-completions, swank:apropos-list-for-emacs): Implemented.
+	* swank-scheme48/load.scm, swank-scheme48/defrectypeX.scm: Renamed 
+	the file from defrectype*.scm
+	* swank-scheme48/packages.scm (swank-general-rpc): Don't use
+	posix-process because it doesn't work on Windows, and we don't need
+	it for a mulithreaded server.
+
+2005-09-22  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-backend.lisp (*gray-stream-symbols*): Collect the needed
+	symbols here, so that we don't need to mention them in every
+	backend.
+	(import-from). New function.
+
+	* swank-sbcl.lisp, swank-allegro.lisp, swank-lispworks.lisp,
+	swank-openmcl.lisp, swank-ecl.lisp: Use *gray-stream-symbols* when
+	importing the needed symbols.
+	
+	* swank-gray.lisp (stream-fresh-line): Define a method, so that
+	Allegro passes our tests.
+
+2005-09-21  Aleksandar Bakic <a_bakic at yahoo.com>
+	
+	* swank.lisp (accept-authenticated-connection): Minor fix. Ensure
+	that the decoded message is a string before calling string= on it.
+
+2005-09-21  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-setup-command-hooks): Make
+	after-change-functions a buffer-local variable; it's by default
+	global in XEmacs.
+
+	* swank.lisp (throw-to-toplevel): Invoke the `abort-restart'
+	request instead of throwing to the `slime-toplevel' catch tag.
+	(handle-request): Rename the restart from abort to abort-request.
+	(call-with-connection): Remove the slime-toplevel catch tag
+	because with-connection is used in far to many places which aren't
+	at "toplevel".
+
+	* present.lisp (presentation-start, presentation-end): Use
+	finish-output instead of force-output.
+
+	* swank-gray.lisp, swank-cmucl.lisp: Improve stream efficiency by
+	buffering more output. stream-force-output simply does nothing, if
+	the output buffer was flushed less than 200 millisecons before.
+	stream-finish-output can still be used to really flush the buffer.
+	(slime-output-stream): New slot last-flush-time.
+	(stream-finish-output): New function. Do what stream-force-output
+	did previously.
+	(stream-force-output): Buffer more output.
+
+	* slime.el (slime-process-available-input): Oops, don't start a
+	timer for every event.
+	(slime-write-string): Renamed from slime-output-string.
+	(slime-dispatch-event): Rename :read-output to :write-string.
+	(slime-io-speed-test): New command.
+	(slime-open-stream-to-lisp): Fix parens. The coding system should
+	also be set if presentations are disabled.
+
+	* swank.lisp (make-output-function): Rename :read-output to
+	:write-string.
+	(eval-for-emacs, interactive-eval, eval-region): Use finish-output
+	not force-output.
+
+	* swank-sbcl.lisp, swank-openmcl.lisp, swank-allegro.lisp,
+	swank-lispworks: Import `stream-finish-output'.
+
+	* swank-scheme48/io.scm (empty-swank-output-buffer): Rename
+	:read-output to :write-string.
+
+	* swank-scheme48/load.scm (slime48-start): Fix '() vs. #f bug.
+
+2005-09-19  Luke Gorrie  <luke at synap.se>
+
+	* nregex.lisp: Released into the public domain by Lawrence E. Freil.
+
+2005-09-19  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime48): New command.
+
+2005-09-19 Taylor Campbell <campbell at mumble.net>
+
+	* swank-scheme48/: New backend.
+
+2005-09-18  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* bridge.el: cl is required at macro expansion time (because of
+	`block').  Reported by Matthew D Swank.
+
+2005-09-18  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp: Move presentation menu protocol here from present.lisp.
+
+2005-09-15  Alan Ruttenberg <alanr-l at mumble.net>
+	* slime.el (slime-repl-return) don't copy presentation to input if
+	already in input area.
+	
+2005-09-15  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-clisp.lisp (compute-backtrace): Include only "function
+	frames" in the backtrace.  I hope that makes some sense.
+	(sldb-backtrace, function-frame-p): New functions.
+	(*sldb-backtrace*, call-with-debugging-environment, nth-frame):
+	Compute and remember the backtrace when entering the debugger.
+	(arglist): If the function has a function-lambda-expression, fetch
+	the arglist from there.
+	(find-encoding): Use strings instead of 'charset:foo symbols to
+	avoid compile time problems if the charset is not available.
+	Suggested by Vaucher Laurent.
+
+	* swank.lisp (eval-in-emacs): Fix a race condition which occurred
+	with sigio.
+	(*echo-area-prefix*): New variable.
+
+	* slime.el (slime-process-available-input): Simplify it a bit and
+	make it easier to debug read errors.
+	(slime-net-close): Don't kill the buffer if the new optional arg
+	`debug' is true.
+	(slime-run-when-idle): Accept arguments for the function.
+	(slime-init-connection-state): Close over the proc variable. It
+	was lost when the async evaluation returned.
+	(slime-output-buffer, slime-connection-output-buffer): Make
+	slime-output-buffer faster by keeping the buffer in a connection
+	variable.
+	(slime-restart-inferior-lisp-aux, slime-quit-lisp): Disable the
+	process filter to avoid errors in XEmacs.
+
+2005-09-14  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* slime.el (slime-menu-choices-for-presentation), (slime-presentation-menu)
+	Fix loss after refactoring. xemacs can't handle lambda forms in
+	the menu spec given to x-popup-menu, only symbols, so save the
+	actions in a hash table keyed by a gensym, give x-popup-menu the
+	gensym and then call the gensym. Haven't checked that it actually
+	works in xemacs because my xemacs is hosed in os x Tiger. Could
+	someone let me know...
+	
+	* swank.lisp (inspect-factor-more-action)
+	rename (inspect-show-more-action) Prompt before reading how many
+	more. Would be nicer to prompt in the minibuffer...
+	
+2005-09-14  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-presentation-expression): Remove handling of
+	cons presentation-ids. 
+
+2005-09-13  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* slime.el (defcustom slime-ed-use-dedicated-frame ... vs defvar
+
+	(defcustom slime-when-complete-filename-expand: Use
+	comint-replace-by-expanded-filename instead of
+	comint-dynamic-complete-as-filename to complete file names
+
+	* swank.lisp (run-repl-eval-hooks .. finally (return vs no return
+
+	inspector-call-nth-action Allow second value :replace for inspector actions
+
+	(defvar *slime-inspect-contents-limit* default nil. How many elements of
+        a hash table or array to show by default. If table has more than
+        this then offer actions to view more. Set to nil for no limit. Probably should
+	set default to reasonable value - I like 200. 
+
+	(inspect-for-emacs ((ht hash-table) inspector)) - banner line is hash table object. 
+	Respect *slime-inspect-contents-limit*
+
+	(defmethod inspect-for-emacs ((array array) inspector) 
+	Respect *slime-inspect-contents-limit*
+
+	* swank-openmcl.lisp inspector for closures shows closed-over
+	values. To be fixed: inspector-princ needs to be loaded earlier
+	since swank package not available when compiling
+	
+2005-09-13  Helmut Eller  <heller at common-lisp.net>
+
+	* present.lisp (menu-choices-for-presentation-id): Use
+	lookup-presented-object secondary return value instead of
+	*not-present*.
+	(execute-menu-choice-for-presentation-id, presenting-object-1):
+	Remove references to *can-print-presentation*.
+
+	* slime.el (slime-current-output-id): Remove this ugly klugde.
+	(slime-repl-insert-result): New function. Handle the presentations
+	and other special cases cleaner.
+	(slime-repl-insert-prompt): Use it. The `result' arg is now a
+	structured list; update callers accordingly.
+	(slime-repl-return): Make the prefix arg work again.
+	(package-updating): The result of swank::listener-eval changed a
+	bit. Update the test.
+	
+	Remove some unnecessary uses of `defun*' and reindent it to 80
+	columns.
+	
+	* swank.lisp: Simplify the object <-> presentation-id mapping.
+	(save-presented-object): Remove the optional `id' arg.
+	(lookup-presented-object): Id should be a fixnum not some cons
+	with fuzzy/non-documented meaning.  Use the secondary return value
+	to test for absence of the id.  Update callers accordingly.
+	(*not-present*): Deleted.
+
+	Remove the repl result special cases, let the general presentation
+	machinery handle it.
+	(*last-repl-result-id*, add-repl-result, *current-id*)
+	(clear-last-repl-result): Deleted.
+	(listener-eval): Don't *current-id* to tag result values.
+	
+	(*can-print-presentation*): Deleted. Nobody quite knows whether
+	it's still needed so let just try without it.  Updated referrers
+	accordingly.
+
+	(eval-region, run-repl-eval-hooks): Move the eval hook stuff to
+	a separate function.
+
+	* swank-loader.lisp (lisp-version-string)[cmu]: Replace spaces
+	with underscores.
+
+2005-09-12  NIIMI Satoshi <sa2c at sa2c.net>
+
+	* swank.lisp, slime.el, swank-clisp.lisp, swank-sbcl.lisp: add
+	EUC-JP as coding system.  This patch eliminates the requirement of
+	Mule-UCS to use Japanese characters.  (Nice for pre-22 Emacs
+	users.)
+
+2005-09-10  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-enable-evaluate-in-emacs): Resurrected.
+	(slime-dispatch-event): Respect slime-enable-evaluate-in-emacs for
+	messages :eval-no-wait and :eval.
+
+2005-09-09  Alan Ruttenberg <alanr-l at mumble.net>
+	* slime.el (slime-choose-overlay-region). Don't try to overlay a
+	note if location is nil.
+
+2005-09-08  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* bridge.el Fix bug in bridge filter where a bridge message which
+	straddled a packet would be mishandled. Sometimes this would
+	result in spurious bridge message text being inserted with the
+	presentation and the presentation not being sensitive. In other
+	cases there would be an actual error. Introduce bridge-leftovers
+	to save the last, unfinished bit for the next call, and prepend it
+	before processing a chuunk. Also, fix the parentheses so that the
+	unwind protect cleanup forms are actually in the cleanup section.
+	In openmcl, where apparently communication with slime is done in
+	2k chunks, you can trigger the bug with something like this:
+	(swank::presenting-object 'foo t 
+	  (dotimes (i 2040) (write-char	#\:)))
+
+	* swank-openmcl.lisp (handle-compiler-warning). Don't create a
+	location if the condition doesn't have a filename. If it does,
+	make sure you pass a string rather than a pathname object
+	otherwise you get a net-read error
+	
+2005-09-07  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* present.lisp (menu-choices-for-presentation): The
+	Inspect/Describe/Copy items are now provided from the Emacs side.
+	Implement all pathname menu items without having Emacs evaluate a
+	form.  Fix for Lisps where ".lisp" is parsed as :name ".lisp". 
+
+	* slime.el (slime-menu-choices-for-presentation): New function,
+	return a menu with Inspect/Describe/Copy plus the items that come
+	from the menu protocol.
+	(slime-presentation-menu): Security improvement for the
+	presentation menu protocol: Don't eval arbitrary forms coming from
+	the Lisp.  Minor cleanup: Use x-popup-menu in the normal Emacs way,
+	associating a command with each menu item.
+
+2005-09-05  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (background-message): New function. Forward the
+	call to the front end.
+	(pre-gc-hook, post-gc-hook): Use it.
+	(swank-sym, sending-safe-p): Deleted.
+
+	* swank.lisp (y-or-n-p-in-emacs): Simplify arglist.
+	(evaluate-in-emacs, dispatch-event, send-to-socket-io): Remove
+	evaluate-in-emacs stuff.
+	(to-string): Undo last change. to-string is not to supposed to
+	ignore errors.  Bind *print-readably* instead.
+	(background-message): New function.
+	(symbol-external-p): Simplify it a little.
+
+	* slime.el (slime-setup-command-hooks): Add after-change-functions
+	only if presentations are enabled.
+	(slime-dispatch-event, slime-enable-evaluate-in-emacs)
+	(evaluate-in-emacs): Remove evaluate-in-emacs stuff.  It was not
+	used and redundant.
+	(slime-save-some-lisp-buffers): Renamed from
+	save-some-lisp-buffers.
+	(slime-choose-overlay-region): Ignore :source-form locations.
+	(slime-choose-overlay-for-sexp): Ignore errors when stepping over
+	forms.
+	(slime-search-method-location, slime-goto-location-position): Move
+	all this regexpery to its own function.
+	(slime-recenter-if-needed, slime-repl-return): Factor some
+	duplicated code into its own function.
+	(slime-presentation-bounds, slime-presentation-around-point)
+	(slime-presentation-around-or-before-point): Minor cleanups.
+
+2005-09-04  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-ensure-presentation-overlay): New.
+	(slime-add-presentation-properties): Don't add face, mouse-face,
+	keymap text properties.  Call slime-ensure-presentation-overlay to
+	implement them via overlays.
+	(slime-remove-presentation-properties): Don't remove these text
+	properties.  Delete the right overlay.
+	(slime-after-change-function): Add overlays for presentations if
+	necessary. 
+	(slime-copy-presentation-at-point): Don't add face text property.
+	(slime-repl-grab-old-output): Likewise.
+
+2005-08-31  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (to-string): Handle errors during printing of objects.
+
+2005-08-30  Alan Ruttenberg <alanr-l at mumble.net>
+	* slime.el (slime-mark-presentation-start/end-handler) modify
+	regexp to recognize negative presentation ids to make
+	presenting-object work with bridge mode.
+	
+2005-08-30  Luke Gorrie  <luke at synap.se>
+
+	* present.lisp: Added public domain dedication (OK'd by Alanr and
+	Matthias on the list).
+
+2005-08-29  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-lispworks.lisp (env-internals:confirm-p): Use new function
+	y-or-n-p-in-emacs rather than eval-in-emacs.
+
+	* swank-cmucl.lisp (eval-in-emacs): Removed.
+	(send-to-emacs): New.
+	(pre-gc-hook, post-gc-hook): Use new protocol message
+	:background-message rather than eval-in-emacs.
+
+	* swank.lisp (dispatch-event, send-to-socket-io): Handle new
+	messages :y-or-n-p, :background-message.  
+	(y-or-n-p-in-emacs): New function.
+
+	* slime.el (slime-dispatch-event): Handle new messages :y-or-n-p,
+	:background-message. 
+	(slime-y-or-n-p): New.
+
+2005-08-29  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* slime.el (sldb-insert-condition) - Add tooltip for long
+	condition string which otherwise falls off the right of the screen
+	* swank.lisp (list-threads) - thread name might be a symbol - pass
+	the symbol name when that happens
+
+2005-08-29  Juho Snellman  <jsnell at iki.fi>
+
+	* swank-sbcl.lisp (make-weak-key-hash-table): Remove the 
+        implementation; SBCL doesn't actually support weak hash-tables.
+
+2005-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-repl-kill-input): New command.
+	(slime-repl-mode-map): Bind it to C-c C-u, like in comint.
+	(slime-repl-easy-menu): Include it in the REPL menu.
+	(slime-repl-mode-hook): Show the SLIME menu in the REPL too.
+
+	* swank-backend.lisp (make-weak-key-hash-table)
+	(make-weak-value-hash-table): New interfaces.
+	* swank-cmucl.lisp (make-weak-key-hash-table): Implement it.
+	* swank-sbcl.lisp (make-weak-key-hash-table): Implement it.
+	* swank-openmcl.lisp (make-weak-key-hash-table) 
+	(make-weak-value-hash-table): Implement it.
+
+	* swank.lisp (*object-to-presentation-id*)
+	(*presentation-id-to-object*): Use new functions
+	make-weak-key-hash-table, make-weak-value-hash-table.
+
+	* slime.el (slime-enable-evaluate-in-emacs): New variable.
+	(evaluate-in-emacs): Security improvement: If
+	slime-enable-evaluate-in-emacs is nil (the default), don't
+	evaluate forms sent by the Lisp.
+
+	* swank.lisp (send-to-socket-io): Handle :evaluate-in-emacs.
+
+2005-08-27  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-presentation-menu): When an object is no longer
+	recorded, remove text properties from the presentation.
+
+2005-08-15  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* swank-openmcl.lisp (condition-source-position)
+	ccl::compiler-warning-stream-position is sometimes nil, so placate
+	this function by making it (or .. 0). Wrong but I don't have
+	enough time now to figure out what the right thing is.
+	
+
+2005-08-24  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (fuzzy-find-matching-symbols): When completing the
+	string "package:" present a list of all the external symbols in
+	package (completing "package::" lists internal symbols as well).
+	(inspect-for-emacs standard-class): List all the slots in the
+	class (as per standard-object). The previous method of hard coding
+	the slots in the inspector's code made inspecting custom
+	meta-classes useless.
+
+2005-08-24  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* swank-sbcl.lisp (method-definitions): present qualifiers (if
+	any).
+
+2005-08-23  Taylor R. Campbell  <campbell at bloodandcoffee.net>
+
+	* slime.el (slime-goto-location-position): Added a second regexp
+	for the :function-name case which matches "(def... ((function-name
+	..." (with N opening parens preceding the function name). This is
+	to allow scheme48 style function names and definitions.
+
+2005-08-22  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp (fspec-pathname): Cope with CVS CLISP's
+	(documentation symbol 'sys::file) returning a list.  Return either
+	a list of start and end line positions or nil as second value.
+	(fspec-location): Use it.  Also, if we have to guess the name of a
+	source file make sure that it actually exists.
+
+	(with-blocked-signals, call-without-interrupts): Don't add
+	:linux to *features* since this changes the return value of
+	unique-directory-name in swank-loader.lisp.
+	Comment out with-blocked-signals.
+
+	Update some comments at the top of the file.
+	State the licence in the same terms as slime.el does.
+
+2005-08-21  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* present.lisp (menu-choices-for-presentation-id): Check against
+	the gensym in *not-present* instead of :non-present.
+
+2005-08-20  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* swank-sbcl.lisp (preferred-communication-style): guard against
+	non-Linux non-linkage-table platforms (and assume that they won't
+	have dodgy threads) with #+linux.
+	
+2005-08-20  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Enable nested presentations.
+	
+	* slime.el (slime-presentation): Remove slots start-p, stop-p.
+	(slime-add-presentation-properties): Use a new text property
+	layout.  Also add an overlay to enable nested highlighting.
+	(slime-remove-presentation-properties): New.
+	(slime-presentation-whole-p): Changed interface.
+	(slime-presentations-around-point): New.
+	(slime-same-presentation-p): Removed.
+	(slime-presentation-start-p, slime-presentation-stop-p): New.
+	(slime-presentation-start, slime-presentation-end): Changed to use
+	new text property layout.
+	(slime-presentation-bounds): New.
+	(slime-presentation-around-point): Reimplemented to handle nested
+	presentations. 
+	(slime-for-each-presentation-in-region): New.
+	(slime-after-change-function): Use
+	slime-remove-presentation-properties and
+	slime-for-each-presentation-in-region. 
+	(slime-copy-presentation-at-point): Complain if no presentation.
+	(slime-repl-insert-prompt): Don't put rear-nonsticky text property.
+	(slime-reify-old-output): Handle nested presentations.
+	(slime-repl-return): Use slime-presentation-around-or-before-point.
+
+	Enable reification of presentations in non-REPL buffers.
+	
+	* slime.el (slime-buffer-substring-with-reified-output): New,
+	factored out from slime-repl-current-input.
+	(slime-repl-current-input): Use it here.
+	(slime-last-expression): Use it here.
+
+	(slime-add-presentation-properties): Add text properties
+	modification-hooks et al. to enable self-destruction of incomplete
+	or edited presentations in non-REPL buffers.
+	
+2005-08-15  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el (slime-goto-location-position) fix so the :method locator
+	regexp so that it can find eql specializers, (setf foo) methods, and to
+	allow (a single) newline between arguments in the arglist.
+
+	* swank-openmcl.lisp (specializer-name) patch from Gary Byers and
+	Bryan O'Conner to fix complaint about certain classes slipping
+	through the etypecase
+	
+2005-08-14  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-mark-presentation-end): Really remove the
+	presentation-start entry from the hash table.
+
+	Merge some code from present.lisp, removing code duplication.
+	Minor code clean-up.
+	
+	* swank.lisp (*object-to-presentation-id*)
+	(*presentation-id-to-object*, clear-presentation-tables)
+	(*presentation-counter*, lookup-presented-object): Move here from
+	present.lisp.
+	(save-presented-object): Likewise.  Assign negative numbers only,
+	so as not to clash with continuation ids.
+
+	* swank.lisp (*repl-results*): Removed.
+
+	* swank.lisp (get-repl-result, clear-repl-results): Use new
+	implementations from present.lisp. 
+	(add-repl-result): Likewise, don't take the negative of the id.
+	(*last-repl-result-id*): New variable.
+	(clear-last-repl-result): Use it here.
+
+	* slime.el (slime-repl-insert-prompt): Don't take the negative of
+	the id. 
+	(slime-presentation-expression): New, take care to handle
+	arbitrary *read-base* settings.
+	(reify-old-output): Use it here.
+	(slime-read-object): Use it here.
+
+2005-08-12  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (substring-no-properties): Fix to handle non-zero start
+	argument correctly. 
+
+	Patch to remove use of the slime-repl-old-output text property in
+	favor of the slime-repl-presentation text property, in order to
+	simplify the code. 
+	
+	* slime.el (slime-presentation-whole-p): Generalize to work with
+	strings too. 
+	(slime-presentation-start, slime-presentation-end): Likewise.
+	(slime-presentation-around-point): Likewise.
+	(slime-presentation-around-or-before-point): New.
+
+	* slime.el (reify-old-output): Use slime-repl-presentation
+	property and slime-presentation-around-point function rather than
+	slime-repl-old-output property.
+	(slime-repl-return): Use slime-repl-presentation rather than
+	slime-repl-old-output.
+	(slime-repl-grab-old-output): Use
+	slime-presentation-around-or-before-point.
+	(slime-read-object): Use slime-presentation-around-point.
+
+	* slime.el (toplevel): Don't handle slime-repl-old-output text
+	property. 
+	(slime-add-presentation-properties): Likewise.
+	(slime-after-change-function): Likewise.
+
+2005-08-12  Yaroslav Kavenchuk <kavenchuk at jenty.by>
+
+	* swank-clisp.lisp (fspec-pathname): Use the documentation
+	function instead of accessing clisp internals.
+	
+2005-08-11  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp (transpose-lists): Fixed it.
+
+2005-08-10  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el move slime-repl-add-to-input-history to
+	slime-repl-send-input so we can see the presentations we copied to
+	input when we reuse history rather than #.(blah...)
+	[Thanks Matthias! - was very busy and just returned to see your
+	changes merged. Most excellent.]
+
+2005-08-10  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-presentation-around-point): Change interface,
+	return presentation as primary return value.
+	(slime-copy-presentation-at-point): Use
+	slime-presentation-around-point.  Copying now also works when the
+	first character is clicked and when the REPL buffer is not current.
+	(slime-presentation-menu): Use slime-presentation-around-point.
+
+2005-08-10  Martin Simmons <martin at lispworks.com>
+
+	* swank-lispworks.lisp (defadvice compile-file): Return all values
+	from the real compile-file.
+
+2005-08-10  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp (transpose-lists): Replaced with much nicer function
+	by Helmut Eller.
+
+2005-08-09  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-read-object): Handle ids that are conses.
+	Patch by "Thas" on #lisp.
+
+2005-08-09  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp (transpose-lists): Reimplemented without APPLY so we
+	don't have problems with CALL-ARGUMENTS-LIMIT.
+
+2005-08-08  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (undo-in-progress): Define for XEmacs compatibility.
+	Reported by Friedrich Dominicus.
+
+2005-08-07  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Fix for the presentations menu.  Reported by Aleksandar Bakic.
+	
+	* present.lisp (lookup-presented-object): Handle ids that are
+	conses. 
+	(execute-menu-choice-for-presentation-id): Use equal for comparing
+	ids, to handle the cons case.
+	(menu-choices-for-presentation): Quote the presentation id, as it
+	can be a cons.
+	* slime.el (slime-presentation-menu, slime-presentation-menu) 
+	(slime-inspect-presented-object): Quote the presentation id.
+
+2005-08-06  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (form-completion): New generic function, factored out
+	from complete-form.
+	(complete-form): Factor out form-completion.
+	(form-completion): Specialize on defmethod forms to insert arglist
+	of generic function.
+
+	* doc/slime.texi (Programming Helpers): Document C-c C-s,
+	slime-complete-form. 
+
+2005-08-04  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Improvements to the presentations feature.  Parts of presentations
+	can be copied reliably using all available Emacs facilities (not
+	just kill-ring-save), and they are no longer "semi-readonly" (in
+	the sense that keypresses are silently ignored).  Whenever a user
+	attempts to edit a presentation, it now simply turns into plain
+	text (which is indicated by changing the face); this can be
+	undone.  Presentations are now also supported if
+	*use-dedicated-output-stream* is nil.  It is now possible to
+	access the individual values of multiple-value results.  For some
+	systems (Allegro CL and upcoming CMUCL snapshots), presentations
+	can be reliably printed through pretty-printing streams.
+	
+	* present.lisp (slime-stream-p) [allegro]: Allow printing
+	presentations through pretty printing streams.
+	[cmu]: Allow printing presentations through pretty printing
+	streams, if CMUCL has annotations support and we are using the
+	bridge-less protocol.
+	[sbcl]: Allow printing presentations through indenting streams.
+	
+	* present.lisp (write-annotation): New function.
+	(presentation-record): New structure.
+	(presentation-start, presentation-end): New functions, supporting
+	both bridge protocol and bridge-less protocol.
+	(presenting-object-1): Use them here.
+
+	* present.lisp [sbcl, allegro]: Add printer hooks for unreadable
+	objects and pathnames.
+	
+	* swank.lisp (*can-print-presentation*): New variable, moved here
+	from present.lisp.
+	* swank.lisp (interactive-eval, listener-eval, backtrace) 
+	(swank-compiler, compile-file-for-emacs, load-file) 
+	(init-inspector): Bind *can-print-presentation* to an appropriate
+	value.  
+	* present.lisp: Remove code duplication with swank.lisp for the
+	functions above.
+
+	* swank.lisp (encode-message): Don't use the pretty printer for
+	printing the message length.
+
+	* slime.el (slime-dispatch-event): New events :presentation-start,
+	:presentation-end for bridge-less presentation markup.
+	* swank.lisp (dispatch-event, send-to-socket-io): Likewise.
+
+	* swank.lisp (listener-eval): Store the whole values-list with
+	add-repl-result. 
+	* slime.el (slime-repl-insert-prompt): Accept a list of strings,
+	representing individual values of a multiple-value result.  Mark
+	them up as separate presentations.
+	(reify-old-output): Support reifying individual values of a
+	multiple-value result.
+
+	* slime.el (slime-pre-command-hook): Don't call
+	slime-presentation-command-hook.
+	(slime-post-command-hook): Don't call
+	slime-presentation-post-command-hook.
+	(slime-presentation-command-hook): Removed.
+	(slime-presentation-post-command-hook): Removed.
+
+	* slime.el (slime-presentation-whole-p): New.
+	(slime-same-presentation-p): New. 
+	(slime-presentation-start, slime-presentation-end): New.
+	(slime-presentation-around-point): New.
+	(slime-after-change-function): New.
+	(slime-setup-command-hooks): Install slime-after-change-function
+	as an after-change-function.
+	
+	* slime.el (slime-repl-enable-presentations): Make
+	slime-repl-presentation nonsticky.
+	(slime-mark-presentation-start, slime-mark-presentation-end): New
+	functions. 
+	(slime-mark-presentation-start-handler): Renamed from
+	slime-mark-presentation-start. 
+	(slime-mark-presentation-end-handler): Renamed from
+	slime-mark-presentation-end. 
+	(slime-presentation): New structure.
+	(slime-add-presentation-properties): New function.
+	(slime-insert-presentation): New function.
+
+2005-08-03  Zach Beane  <xach at gwi.net>
+
+	* swank-sbcl.lisp (swank-compile-string): Restore honoring of
+	*trap-load-time-warnings*.
+
+2005-08-03  Juho Snellman  <jsnell at iki.fi>
+
+	* swank-sbcl.lisp: Remove SBCL 0.9.1 support.
+        (swank-compile-string): Funcall the compiled function outside
+        with-compilation-hooks to prevent runtime warnings from 
+        popping up a *compiler-notes* buffer.
+
+2005-07-29  Marco Baringer  <mb at bese.it>
+
+	* doc/slime.texi (Other configurables): Document
+	*dedicated-output-stream-port*.
+
+	* swank.lisp (*dedicated-output-stream-port*): New variable.
+	(open-dedicated-output-stream): Open the stream on the port
+	*dedicated-output-stream-port*.
+
+	* slime.el (slime-set-default-directory): Fix typo in doc string.
+
+2005-07-26  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank.lisp (inspect-for-emacs): Don't make whitespace
+	surrounding :action buttons part of the highlighted region.
+
+	* slime.el (slime-goto-location-buffer): Put "SLIME Source Form"
+	buffer into Lisp mode.
+	
+2005-07-26  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (compile-file-for-emacs): Accept optional
+	external-format arg.  I frogot to commit this file on 2005-07-05.
+
+	* slime.el (slime-input-complete-p): Skip over strings too.
+	
+2005-07-26  Zach Beane  <xach at xach.com>
+
+	* swank-sbcl.lisp (swank-compile-string): Revert to old string
+	compilation behavior to fix compiler note annotations. Code from
+	Juho Snellman.
+
+2005-07-24  Tom Pierce <tlpierce at gmail.com>
+
+	* swank.lisp (format-iso8601-time): New functions. Properly
+	formats a universal-time as an iso8601 string.
+	(inspect-for-emacs integer): Use the new
+	format-iso8601 function when printing an integer as a date.
+	
+2005-07-22  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (frame-catch-tags): Remove some debugging
+	forms which were "polluting" the repl buffer when viewing an sldb
+	buffer.
+	(function-source-location): Make :error messages have the proper
+	form (exactly one string argument). This fix also removes the
+	issues with sending unreadble lists (containing #<...> to emacs).
+
+2005-07-14  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (find-external-format): Fix typo.
+
+2005-07-06  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-send-sigint): Use the symbol SIGINT stead of the
+	signal number.  Suggested by Joerg Hoehle.
+	(slime-compile-file): XEmacs needs the buffer as argument to
+	local-variable-p.  Reported by Andy Sloane.
+
+2005-07-05  Helmut Eller  <heller at common-lisp.net>
+
+	The file variable slime-coding can now be used to specify the
+	coding system to use for C-c C-k.  E.g., if the file contains
+	-*- slime-coding: utf-8-unix -*- Emacs will tell the Lisp side
+	to call COMPILE-FILE with an external-format argument.
+	
+	* slime.el (slime-compile-file): Send the coding system if
+	the buffer local variable `slime-coding' is bound.
+
+	* swank-backend.lisp, swank-sbcl.lisp, swank-clisp.lisp,
+	swank-lispworks.lisp, swank-cmucl, swank-allegro.lisp,
+	swank-abcl.lisp, swank-corman.lisp 
+	(swank-compile-file): New optional argument `external-format'.
+
+	* swank-clisp.lisp (getpid): Undo the last change.
+
+	* swank-corman.lisp (spawn, thread-alive-p): More thread tweaking.
+	
+2005-07-03  Joerg Hoehle <hoehle at users.sourceforge.net>
+
+	* swank-clisp (describe-symbol-for-emacs): Report :setf and :type
+	where appropriate.
+
+2005-07-03  Helmut Eller  <heller at common-lisp.net>
+	
+	* slime.el (next-single-char-property-change)
+	(previous-single-char-property-change) [xemacs]: Only define them
+	if not present.
+	(next-char-property-change, previous-char-property-change): Define
+	if needed.
+
+	* README: Show examples for the filenames instead of the general
+	"/the/path/to/this/directory".  Suggested by Brandon J. Van Every.
+
+	* swank-corman.lisp (default-directory): Return a namestring
+	instead of the pathname.
+	(inspect-for-emacs, inspect-structure): Teach the inspector how to
+	deal with structures.
+	(spawn, send, receive): Implement rudimentary threading support.
+	It's now possible to connect with the :spawn communication style
+	and to bring up a listener.  Unfortunately, debugging the
+	non-primary threads doesn't work at all.  Still no support for
+	interrupt-thread.
+	
+	* slime.el (slime-start-swank-server): Send an extra newline
+	before the "(swank:start-server ...".  I don't know why, but this
+	seems to fix the problem when starting CLISP/Win32.  Interrupting
+	CLISP/W32 is still horribly broken.
+
+	* swank-loader.lisp (compile-files-if-needed-serially) [corman]:
+	force-output after each file.
+
+2005-07-02  Marco Baringer  <mb at bese.it>
+
+	* slime.el (save-some-lisp-buffers): New Function.
+	(slime-repl-only-save-lisp-buffers): New customizable variable.
+	(slime-repl-compile-and-load): Use save-some-lisp-buffers.
+	(slime-oos): Use save-some-lisp-buffers.
+
+2005-07-01  Gábor Melis  <mega at hotpop.com>
+
+	* swank-sbcl.lisp (threaded stuff): make SBCL 0.9.2.9+ work while
+	retaining support for 0.9.2
+
+2005-06-28  Gábor Melis <mega at hotpop.com>
+
+	* swank-sbcl.lisp (threaded stuff): horrible hack to make threaded
+	SBCL 0.9.2 work.  (also, Happy Birthday Christophe!)
+
+2005-06-21  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp (find-matching-packages): Also use nicknames.
+
+2005-06-13  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp (list-all-systems-in-central-registry): Delete
+	duplicates.
+
+	* swank-lispworks.lisp (unmangle-unfun): If you rename a package
+	you should rename it everywhere...
+
+2005-06-12  Alexey Dejneka  <adejneka at comail.ru>
+
+	* slime.el (slime-with-xref-buffer): fix "pgk" typo.
+
+2005-06-12  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* swank.lisp (ed-in-emacs): allow strings as well as pathnames;
+	don't call emacs for things that the emacs editor doesn't know how
+	to deal with.  Return T if we called emacs and NIL if not.
+
+	* slime.el (slime-ed): Change a listp to consp, so that NIL
+	arguments are correctly handled.
+
+2005-06-11  Nikodemus Siivola <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp: Patched for SBCL HEAD: utilize the new
+	:source-plist functionality; maintain compatibility with 0.9.1
+	till 0.9.2 is out. Removed cruft left over from previous
+	excercises in supporting both HEAD and latest release.
+
+	* doc/slime.texi: Document Slime as supporting the latest official
+	release of SBCL, as opposed to a specific version number which
+	would need to be updated monthly.
+
+2005-06-10  Helmut Eller  <heller at common-lisp.net>
+
+	* nregex.lisp (slime-nregex): Rename package to avoid name clashes
+	with other version of this file.
+
+	* swank.lisp (compiled-regex): Use the new package name.
+
+	* slime.el (slime-with-xref-buffer): Gensym package too, to avoid
+	problems when switching to buffers with -*- package: ... -*- file
+	variables.  From Antonio Menezes Leitao.
+	(slime-property-bounds): Use the prop argument instead of the
+	hardcoded 'slime-repl-old-output.  From Andras Simon.
+
+2005-06-07  Espen Wiborg  <espenhw at grumblesmurf.org>
+
+	* swank-corman.lisp: Convert to Unix line-endings.
+	(create-socket): Pass through the port argument unmodified,
+	gettting a random port if 0.  Requires supporting change in
+	<ccl>/modules/sockets.lisp.
+	(inspect-for-emacs): defimplementation instead of defmethod.
+
+2005-06-06  Espen Wiborg  <espenhw at grumblesmurf.org>
+
+	* doc/slime.texi, PROBLEMS: Added notes about CCL.
+
+2005-06-03  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-background-activities-enabled-p): Allow
+	background stuff in repl-mode buffers too.
+
+	* swank-cmucl.lisp (sis/misc): Return t for :interactive-p.
+
+2005-06-01  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-load-system, slime-oos): Fix bug related to file
+	locking.  Don't bind the variable system-name.  system-name is a
+	predefined Emacs variable and is used among other things for lock
+	filenames.
+
+2005-06-01  Joerg Hoehle <hoehle at users.sourceforge.net>
+
+	* swank-clisp (getpid): Updates for current CLISP versions. Use
+	defimplementation. Define always (slime needs it).
+	
+2005-06-01  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-background-activities-enabled-p): Return nil
+	instead of signalling an error if there is a open but no default
+	connection.
+	(slime-current-connection): New helper function.
+	(slime-connection): Use it.
+	(slime-first-change-hook): Only run when
+	slime-background-activities-enabled-p.
+
+2005-06-01  Joerg Hoehle <hoehle at users.sourceforge.net>
+
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-clisp.lisp
+	(describe-symbol-for-emacs): Distinguish macro and special
+	operators from functions.
+
+	* slime.el (slime-print-apropos): Must keep in sync with above,
+	therefore added :macro and :special-operator properties.
+
+	* swank.lisp (present-symbol-before-p): Make it conform to its
+	specification -- sort first by package and then by symbol name.
+
+	* swank-clisp.lisp (describe-symbol-for-emacs): Report :alien-type
+	when the name is known as foreign type.
+
+2005-06-01  Espen Wiborg  <espenhw at grumblesmurf.org>
+
+	* swank-loader.lisp: Redefine compile-files-if-needed-serially for
+	Corman Lisp to load everything from source.
+
+2005-05-27  Espen Wiborg  <espenhw at grumblesmurf.org>
+
+	* swank-corman.lisp: New file, swank for Corman Lisp.
+
+	* swank.lisp (simple-announce-function): force-output after
+	announcing.
+	(symbol-external-p): Be extra paranoid about the symbol's package;
+	find-symbol barfs on a nil package in Corman Lisp.
+
+	* swank-loader.lisp: Add Corman Lisp support.
+
+2005-05-24  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el text-property-default-nonsticky not defined in
+	xemacs. oops.
+
+2005-05-24  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el meta-w now removes properties before insertion if you
+	cut just a portion of the presentation. Added xemacs
+	support. Enabled in xemacs.
+
+2005-05-23  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el slime-presentation-menu - use with-current-buffer, so
+	that menus work even if you are not in the buffer with the
+	presentation.
+
+	* present.lisp More menu items for pathnames. Remember last
+	slime-stream-p value. *can-print-presentation* t during
+	swank-compiler and during presentation menu action.
+
+2005-05-22  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* present.lisp. (slime-stream-p) check if a stream is destined for
+	output in a slime listener. (checks *connections* looks into pretty-print
+	streams in openmcl and cmucl)
+	Don't present unless (slime-stream-p stream).
+
+	Variable *enable-presenting-readable-objects* The only readable object
+	which is presented are pathnames (e.g. pathnames printed when loading
+	and *load-verbose* is t). Try the useful menu :)
+	More to come if this doesn't cause problems.  (nil this if it does)
+
+	*can-print-presentation* t around compile-string-for-emacs,
+	load-file, interactive-eval.
+
+	In cmucl, use fwrappers to modify behaviour rather than redefinition.
+
+2005-05-22  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* present.lisp. mouse-3 now gives a menu for actions on the
+	presentation. See documentation in file for information about how
+	to define menus. Also, disable presentations in inspector. Initial bits
+	of dealing with the possibility of presenting readable objects.
+
+	* slime.el support menu. Xemacs users beware this uses x-popup-menu, 
+	which may be fsf specific.
+	
+2005-05-20  Alan Ruttenberg  <alanr-l at mumble.net>
+	* swank.lisp make repl output presentation work even if
+	present.lisp not loaded
+
+2005-05-20  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-repl-enable-presentations): Default is enabled
+	in GNU Emacs but disabled in XEmacs. Feature is not portable yet.
+	Brutally 80-column'ified alanr's latest changes :-)
+
+2005-05-20  Alan Ruttenberg  <alanr-l at mumble.net>
+	
+	* bridge.el new file. from ilisp cvs distribution to collect
+	in-band messages using process filter mechanisms. One edit which
+	calls bridge-insert with process argument as well as output
+	
+	* present.lisp new file. Enough code to do the following:
+	(swank::presenting-object object stream (print "This is really
+	object")). This makes the string "This is really object" behave
+	like old repl input for the object. Sample code for openmcl and
+	cmucl that hooks this into the printing of unreadable objects This
+	should be part of swank.lisp (and lisp specific files) but I am
+	too chicken to merge yet. For now you have to load this file
+	manually.
+	
+	* slime.el changes to support above:
+	slime-repl-enable-presentations: customize to enable this stuff.
+	Default value t. Set to nil to turn it off.
+	slime-presentation-start-to-point: map object ids to the (point)
+	where they start to print out. slime-mark-presentation-start,
+	slime-mark-presentation-end. handlers for the bridge messages.
+	slime-open-stream-to-lisp: When enabled start the bridge and
+	define the handlers.
+	
+2005-05-19  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el slime-presentation-map 
+
+2005-05-20  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (clear-repl-results): Fixed unbalanced parens. Thanks
+	Lawrence Mitchell.
+
+2005-05-19  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* slime.el (slime-presentation-command-hook) new function for
+          nicer behaviour for presentations. 
+	(slime-pre-command-hook) do slime-presentation-command-hook
+	(slime-post-command-hook) put pre-command-hook back if goes away
+	(slime-copy-presentation-at-point) mouse-2 copies previous output to point
+	slime-repl-output-mouseover-face what the old output looks like when the mouse moves over it
+	  default: box around it like on lispm
+	(slime-repl-insert-prompt) add mouseover face, mouse action. newline after output not propertized.
+	(slime-property-bounds) adjust for lack of propertized newline
+	to fix: presentation region behaviour should be attach to generic property like
+	  (:acts-as-token t ) rather than tying to repl-output property
+	
+2005-05-19  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (*record-repl-results*): Variable to enable/disable
+	recording of REPL results. True by default.
+	(*repl-results*): Renamed from ****.
+
+	* slime.el (slime-property-bounds): Factored out this common part
+	of slime-repl-grab-old-{input,output}.
+	(slime-read-object): Avoid inline CL code.
+
+2005-05-18  Antonio Menezes Leitao <aml at gia.ist.utl.pt>
+
+	* slime.el (slime-repl-inputed-output-face): new face.
+	(slime-current-output-id): New variable.
+	(slime-dispatch-event): Bind slime-current-output-id when
+	neccessary.
+	(slime-repl-insert-prompt): Add the neccessary text properties to
+	the result.
+	(reify-old-output): New function which makes sure swank sees
+	\(swank::get-**** ...) while the user sees the printed
+	representation of the object.
+	(slime-repl-return): When called on a old output (as per the
+	slime-repl-old-output text property, call
+	slime-repl-grab-old-output.
+	(slime-repl-send-input): Added the slime-repl-old-input text
+	property.
+	(slime-repl-grab-old-input): Keep the old input's text
+	properties (unwanted text properties are removed later).
+	(slime-repl-grab-old-output): New function.
+	(slime-repl-clear-buffer): Added call to swank::clear-****
+	(slime-repl-clear-output): Added call to swank::clear-**** and
+	bind inhibit-read-only to nil.
+	(slime-inspect): Call slime-read-object to get the value to
+	inspect.
+	(slime-read-object): New function which either reads an object
+	from the minibuffer or returns the object at point if it has the
+	slime-repl-old-output text property.	
+
+	* swank.lisp (*current-id*, ****): New variables.
+	(add-****, get-****, clear-last-****, clear-****): New functions
+	for manipulating the repl history.
+	(listener-eval): Add * to ****.
+	
+2005-05-12  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* swank.lisp Add ability to customize behavior of the repl. To do
+	so, add a function to the list swank::*slime-repl-eval-hooks*.
+	This function is passed the form typed into the repl. The function
+	should decide whether it wants to handle evaluation of the
+	form. If not, call (repl-eval-hook-pass) and the next hook is
+	tried. Otherwise the values the function returns are used instead
+	of calling eval. Inside the body of the function you can also
+	suppress having the repl print the result by calling
+	(repl-suppress-output) and/or suppress the advancement of the
+	history variables (*** ** * /// // /) by calling
+	(repl-suppress-advance-history).
+	
+	
+2005-05-11  Tim Daly Jr.  <tim at tenkan.org>
+
+	* swank-source-path-parser.lisp (read-and-record-source-map):
+	Ensure that at least the toplevel form is in the source-map.
+
+2005-05-11  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-remove-old-overlays): Remove overlays in all
+	slime buffers not only in the current buffer.
+	(slime-filter-buffers): New helper.
+	(slime-display-completion-list): Take the completed prefix as
+	additional argument to initialize completion-base-size.  This is
+	apparently needed to make mouse-selection working.
+	(slime-maybe-complete-as-filename): Factor for common code in
+	slime-complete-symbol* and slime-simple-complete-symbol.
+
+2005-05-06  Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* swank-openmcl.lisp specializer-name didn't handle
+	structure-class which caused meta-. of methods specialized on
+	defstruct arguments to fail.
+	
+2005-05-06  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (post-gc-hook): Include the elapsed time and
+	the size distribution.
+
+2005-05-05  Edi Weitz  <edi at agharta.de>
+
+	* swank-lispworks.lisp (unmangle-unfun): New function to convert
+	strange symbols in SETF package to SETF function names.
+	(signal-undefined-functions): Use it.
+
+2005-05-04  Edi Weitz  <edi at agharta.de>
+
+	* swank-lispworks.lisp (call-with-compilation-hooks): Provide
+	better implementation.
+	(compile-file-and-collect-notes): Advice for COMPILE-FILE so
+	pathname information for undefined functions can be recorded.
+	(*within-call-with-compilation-hooks*): New special variable used
+	by CALL-WITH-COMPILATION-HOOKS.
+	(*undefined-functions-hash*): New special variable to record
+	pathname information for undefined functions.
+	(signal-error-database): Make LOCATION parameter optional, use
+	FILENAME info from error database if not provided.
+	(signal-undefined-functions): Make LOCATION parameter optional,
+	use info from *UNDEFINED-FUNCTIONS-HASH* if not provided.
+
+2005-05-03  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (slime-secret): Removed #+unix conditional, suggested
+	by Edi Weitz.
+
+2005-05-02  Mark Wooding  <mdw at nsict.org>
+
+	* swank.lisp: If ~/.slime-secret exists then insist that Emacs
+	sends the contents (as a password) during initial handshaking.
+	(announce-server-port): Use :IF-EXISTS :ERROR to prevent bad guys
+	from slipping a symlink into /tmp and reading what port Lisp is
+	listening on.
+
+	* slime.el: If ~/.slime-secret exists then send it, as per above.
+
+2005-05-01  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-inspector-reinspect): New function which
+	reinspects the current object.
+	(slime-inspector-mode-map): Bind slime-inspector-reinspect to g.
+
+2005-04-29  Dan Pierson <dlp at itasoftware.com>
+
+	* slime.el (slime-parse-context): Fix method parsing so that
+	pressing, say, C-c C-t when point is on a '-' in a symbol name
+	won't break.
+	(slime-browser-map): New variable. Add support for the common 'q'
+	keystroke to quit out of the xref.
+	(slime-fetch-browsable-xrefs): New function. Remove the (FLET ...)
+	entries which appear on at least CMUCL.  I don't believe you can
+	actually expand them on any current implementation and they just
+	mess up the browse tree.  Use only the method name when looking
+	up (METHOD ...) entries on CMUCL.  This really shouldn't be here,
+	but I can't see how to avoid the error thrown by swank:xref.
+	(slime-expand-xrefs): Use it.
+	(slime-call-with-browser-setup): Initialize slime-buffer-package
+	properly.  Previously, lisp-mode was called after setting it, but
+	lisp-mode clears all local variables, use lisp-mode-variables
+	instead.
+
+	* swank-cmucl.lisp (toggle-trace): Be more carefully when tracing
+	methods: try both (METHOD ...) and (PCL:FAST-METHOD ...).
+
+2005-04-27  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (+header-type-symbols+): Drop the third arg to
+	apropos-list; it's no longer supported in recent CMUCLs.
+
+2005-04-21  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (arglist-to-string): Rolled back the previous change
+	because it interferred with values appearing in parameter lists.
+
+2005-04-20  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (arglist-to-string): Bind *PRINT-ESCAPE* to NIL. This
+	way symbols in arglists are printed as with PRINC, i.e. without
+	package qualifier.
+
+	* swank-sbcl.lisp (preferred-communication-style): Use
+	`linux_no_threads_p' alien variable to decide whether to use
+	:SPAWN. From dan_b for compatibility with new SBCLs.
+
+2005-04-19  Helmut Eller  <heller at common-lisp.net>
+
+	* PROBLEMS: Warn about old kernels.
+	
+	* swank-backend.lisp: Fix some typos.
+
+	* swank-sbcl.lisp (preferred-communication-style): Don't test for
+	sb-futex, it has lost its meaning in 0.8.21.
+
+2005-04-18  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (inferior-lisp-program): Defvar it here, in case it is
+	not defined in loaddefs and inf-lisp is not loaded. (That's the
+	case in XEmacs.)
+
+	* mkdist.sh: update version number.
+
+	* doc/slime.texi: Update version numbers for SBCL and ACL.
+
+2005-04-17  Peter Seibel  <peter at gigamonkeys.com>
+
+	* swank-loader.lisp (*implementation-features*): Added features
+	for GCL and ECL ...
+	(lisp-version-string): ... and code to compute version
+	string. (Supplied by someone who's email I've misplaced.)
+
+2005-04-14  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-selector): Discard input after sleeping.
+
+2005-04-09  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (sldb-get-buffer): Create a fresh buffer if there's no
+	buffer for the connection (and don't reuse an existing buffer even
+	if it has a matching name).
+	(slime-buffer-visible-p, slime-ir1-expand): Delete unused
+	functions.  Mark some others as unused, but leave them there
+	because they are potentially useful.
+
+	* swank.lisp (with-io-redirection, with-connection)
+	(with-buffer-syntax): Implement macros with `call-with' functions
+	to avoid some code bloat.
+	(call-with-connection, maybe-call-with-io-redirection)
+	(call-with-buffer-syntax): New functions.
+	(interactive-eval): Use from-string instead of read-from-string to
+	avoid problems whit *read-suppress*.
+
+	* swank-sbcl.lisp: Add a few comments.
+
+	* swank-abcl.lisp (print-frame): Trim whitespace to make the
+	backtrace look a bit terser.
+
+2005-04-07  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-net-coding-system): More fixes for
+	non-mule-XEmacsen.
+	(slime-net-coding-system): Even more fixes to make it for
+	mule-XEmacs.
+	
+2005-04-05  Juergen Gmeiner <gj at gjdv.at>
+
+	* swank-lisworks.lisp (find-top-frame): If we can't find an
+	invoke-debugger frame we take any old frame at the top.
+
+2005-04-04  James McIlree <ovrskeek at mac.com>
+
+	* slime.el (find-coding-system, check-coding-system)
+	(process-coding-system, set-process-coding-system): Dummy
+	functions for no-mule-XEmacsen.
+
+2005-04-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-show-maximum-output): New
+	function. Immitate the scrolling behavior of a terminal.
+	(slime-with-output-end-mark, slime-repl-return)
+	(slime-repl-send-input, slime-display-output-buffer): Use it
+	(slime-lisp-implementation-version, slime-machine-instance): New
+	connection variables.  Suggested by Eduardo Muñoz.
+	(slime-set-connection-info): Initialize them.
+
+	* swank.lisp (connection-info): Include version and hostname in
+	the result.
+
+	* swank-cmucl.lisp (breakpoint-values): Fixes for CMUCL-2005-03
+	snapshot.
+	
+	* doc/slime.texi: Fix spelling errors.
+
+	* cl-indent.el: Remove the file.  Let the Emacs developers
+	maintain it.
+
+2005-04-01  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (sldb-get-buffer): Initialize the buffer local
+	variables slime-buffer-connection and slime-current-thread when
+	creating a fresh buffer.
+
+	* swank.lisp (spawn-repl-thread): Use
+	*default-worker-thread-bindings* just like spawn-worker-thread.
+	(wrap-sldb-vars): New function.  Rebind *sldb-level* to avoid
+	confusion with recursive errors during eval-in-frame.
+	(eval-string-in-frame, pprint-eval-string-in-frame): Use it.
+
+	* swank-allegro.lisp (eval-in-frame): Allegro's
+	eval-form-in-context does nothing special with lexical variables
+	in the frame.  Wrap an explicit LET around the form to get similar
+	behavior as in the other Lisps.
+	(inspect-for-emacs (structure-object)): Remove structure related
+	methods.  It's already covered by the general case with
+	allegro-inspect.
+	(common-seperated-spec): Deleted
+
+2005-04-01  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-xref-mode): Summarise the most important
+	bindings in the mode description.
+
+	* metering.lisp: Now supports only CLISP and OpenMCL.
+	Removed a lot of really ugly reader-conditionalized code, much of
+	it for archaic lisps (#+cltl2, #+lcl3.0, #+mcl1.3.2, etc).
+
+	* swank-source-path-parser.lisp (check-source-path): Signal an
+	error if a source path is malformed. SBCL sometimes gives (NIL).
+	(source-path-stream-position): Use it.
+
+	* slime.el (slime-goto-definition): Handle :error locations here
+	before any window/buffer changes are made.
+
+2005-04-01  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-keys): Bind slime-edit-definition-other-window
+	to `C-x 4 .' and slime-edit-definition-other-frame to `C-x 5 .',
+	shadowing the equivalent find-tag... bindings.
+	(slime-goto-definition): In the other-window and other-frame cases,
+	make sure point does not move in the originating window, even when
+	the definition is found in the same buffer.
+
+2005-03-31  Luke Gorrie  <luke at synap.se>
+
+	* doc/slime.texi (slime-selector): New section.
+	(Inspector): Updated for the post-1.0 inspector.
+
+	* slime.el (slime-selector): Removed unneeded "the" prefixes in
+	descriptions of what the selector methods do.
+
+2005-03-27  Helmut Eller  <heller at common-lisp.net>
+
+	* PROBLEMS, NEWS, doc/slime.texi: Some updates for the upcoming
+	release.
+
+2005-03-27  Russell McManus <russell_mcmanus at yahoo.com>
+
+	* swank-clisp.lisp (getpid): Try sys::process-id if
+	sys::program-id doesn't exist.
+
+2005-03-23  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (commit-edited-value): Read a backquated string,
+	instead of quating the result of read. This allows one to put
+	,(form) into edit-value buffers.
+
+2005-03-22  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-lispworks.lisp (swank-compile-string): Bind *print-radix*
+	to t, to avoid problems if somebody uses different values for
+	*print-base* and *read-base*.  Reported by Alain Picard.
+	(emacs-connected): Add default methods for
+	environment-display-notifier and environment-display-debugger.
+
+2005-03-21  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (locate-compiler-note): Handle errors in macros
+	better.
+	(source-file-source-location): Read the snippet at the right
+	position.
+
+	* swank-source-file-cache.lisp (read-snippet): Take the start
+	position as optional argument.
+
+2005-03-21  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (quit-lisp): If we are running multithreaded,
+	terminate all other threads too.  (still broken in 0.8.20.27; used
+	to work in ~0.8.20.2.)
+	(with-debootstrapping, call-with-debootstrapping): Remove ugly
+	backward compatibility code.
+	(sbcl-source-file-p, guess-readtable-for-filename): New utilities.
+	(function-source-location): Handle work off to helper functions.
+	(find-function-source-location): New function.  Use the
+	shebang-readtable for SBCL source files.
+	(function-source-position, function-source-filename)
+	(function-source-write-date, function-toplevel-form-number)
+	(function-hint-snippet, function-has-start-location-p)
+	(function-start-location): New helpers.
+	(safe-source-location-for-emacs): Don't catch errors if
+	*debug-definition-finding* is true.
+	(inspect-for-emacs): Minor beautifications.
+ 
+	* swank.lisp (commit-edited-value): Use buffer syntax.
+	(compile-file-for-emacs, compile-string-for-emacs): Bind
+	*compile-print* to nil.
+
+	* swank-cmucl.lisp (call-with-debugging-environment): Rebind
+	kernel:*current-level* 0.  Useful for debugging pretty printer
+	code.
+	(inspect-for-emacs): Show details of interpreted functions.
+
+2005-03-21  Luke Gorrie  <luke at synap.se>
+
+	* swank-sbcl.lisp (function-source-location): For definitions
+	compiled in Emacs buffers, include the :emacs-string as a :snippet
+	hint for search-based M-. lookup.
+
+2005-03-21  Edi Weitz  <edi at agharta.de>
+
+	* swank-loader-lisp (*implementation-features*, *os-features*,
+	*architecture-features*): LispWorks was completely missing.
+	
+2005-03-18  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-complete-symbol*-fancy): Now nil by default.
+
+2005-03-18  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-source-path-parser.lisp (make-source-recording-readtable):
+	Ignore non-ascii chars.
+
+	* swank-sbcl.lisp (swank-compile-string): Re-implemented.  This
+	time with temp-files and proper source-location tracking.
+	(install-debug-source-patch, debug-source-for-info-advice): Patch
+	SBCL's debug-source-for-info so that we can dump our own bits of
+	debug info.
+	(function-source-location, code-location-source-path): Rewritten
+	to handle C-c C-c functions.  Also use the source-path to locate
+	the position.
+	(locate-compiler-note): Renamed from resolve-note-location.
+	(temp-file-name, call/temp-file): New utilities.
+	(file-source-location, lisp-source-location)
+	(temp-file-source-location, source-file-source-location)
+	(string-source-position, code-location-debug-source-info)
+	(code-location-debug-source-name, code-location-debug-source-created,)
+	(code-location-debug-fun-fun, code-location-from-emacs-buffer-p)
+	(function-from-emacs-buffer-p, function-debug-source-info)
+	(info-from-emacs-buffer-p, code-location-has-debug-block-info-p)
+	(stream-source-position): Lots of new helper functions.
+	(with-debootstrapping): Moved upwards so that it can be used for
+	source location searching.
+	(source-location-for-emacs): Deleted
+
+2005-03-16  Helmut Eller  <heller at common-lisp.net>
+
+	* slime/swank.lisp (*macroexpand-printer-bindings*): New user
+	variable.
+	(apply-macro-expander): Use it.
+	(call-with-bindings): Bind variables in reverse order. Thit makes
+	it easer to cons or push a new binding at the front the list.
+	(with-bindings): New macro.
+
+	* slime.el (slime-run-when-idle): New function to hide
+	Emacs/XEmacs differences.
+	(slime-process-available-input): Use it.
+
+	* swank-loader.lisp (unique-directory-name): Rewritten to avoid
+	the rather irritating warning that (warn "Don't know ...") is
+	unreachable.
+	
+2005-03-13  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-dispatch-event): Use `slime-busy-p' to control
+	the "; pipelined request" message. This way it takes requests
+	blocked in the debugger into account and avoids spurious messages.
+
+	* swank.lisp (inspect-for-emacs symbol): Add an "unintern it"
+	action for symbols.
+
+	* swank-source-file-cache.lisp (read-snippet): Skip comments and
+	whitespace in SBCL. The source-positions reported by SBCL are not
+	adjusted to skip over whitespace before the definition.
+
+	* swank-sbcl.lisp (function-source-location): Updated for revised
+	sb-introspect patch:
+	s/DEFINITION-SOURCE-CREATED/DEFINITION-SOURCE-WRITE-DATE/
+
+	* swank-loader.lisp (*os-features*): Added :mswindows. Thanks Will
+	Glozer.
+
+2005-03-12  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-edit-value): New function on `C-c E'. Prompts
+	for a Lisp expression, evaluates and displays the result in a new
+	buffer for editing, and then setf's the edited value in Lisp after
+	you press C-c C-c. Usage example: `C-c E asdf:*central-registry*'
+	Minor docstring and pull-down-menu changes.
+
+	* swank.lisp (value-for-editing, commit-edited-value): New
+	functions for slime-edit-value.
+
+	* swank-allegro.lisp (toggle-trace): Fix from Antonio Menezes
+	Leitao.
+
+	* swank-sbcl.lisp: Use swank-source-file-cache to find snippets of
+	definitions. M-. is now much more robust to modifications in the
+	source file.
+	NOTE: To be effective requires a patch to sb-introspect that I
+	have posted to sbcl-devel.
+
+	* swank-source-file-cache.lisp: Factored this into its own file,
+	from swank-cmucl.lisp.
+
+	* swank-loader.lisp, swank-cmucl.lisp: Updated for the above.
+
+2005-03-10  Antonio Menezes Leitao  <aml at gia.ist.utl.pt>
+
+	* slime.el (slime-toggle-trace-fdefinition): If there is no symbol
+	at point then prompt for one.
+
+2005-03-09  Peter Seibel  <peter at gigamonkeys.com>
+
+	* swank-loader.lisp (*architecture-features*): Added :pc386 for CLISP.
+	(unique-directory-name): Change ERROR to WARN.
+
+	* slime.el (slime-register-lisp-implementation): Add facility for
+	registering lisp implementations with symbolic names that can be
+	passed to C-u M-x slime.
+
+2005-03-08  Peter Seibel  <peter at gigamonkeys.com>
+
+	* doc/Makefile (clean): added clean and really_clean targets.
+	(all): and added slime.pdf to all prerequisites.
+
+	* swank-loader.lisp (*implementation-features*): Whoops. Forgot
+	CLISP.
+	(*architecture-features*): Added :x86-64 for SBCL on AMD64 (thanks
+	Vincent Arkesteijn)
+
+2005-03-07  Peter Seibel  <peter at gigamonkeys.com>
+
+	* swank-loader.lisp (unique-directory-name): Replaced *lisp-name*
+	variable with more sophisticated version that accounts for impl,
+	impl version, os, and hardware architecture.
+
+2005-03-07  Edi Weitz  <edi at agharta.de>
+
+	* swank.lisp: Fixed parenthesis-balancing problem.
+
+2005-03-06  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-easy-menu): Add menu item for
+	slime-complete-form.
+
+	* swank.lisp (format-arglist-for-echo-area): Use extra-keywords to
+	enrich the list of keywords.
+	(arglist-to-string): Remove extraneous whitespace.
+	(keyword-arg, optional-arg): New structures.
+	(decode-keyword-arg, decode-optional-arg): Return structure
+	objects rather than multiple values.
+	(encode-keyword-arg, encode-optional-arg, encode-arglist): New
+	functions.
+	(arglist): New slot key-p.
+	(decode-arglist): Handle &whole, &environment.  Store more
+	information on optional and keyword args, set arglist.key-p.
+	(values-equal?): Removed.
+	(print-decoded-arglist-as-template): If keyword is
+	not a keyword symbol, quote it in the template.
+	(extra-keywords): Return a secondary value (allow-other-keys).
+	For make-instance, try to finalize the class if it is not
+	finalized yet (fix for Allegro CL 6.2).  If class is not
+	finalizable, use direct slots instead of slots and indicate that
+	the keywords are not complete.
+	(enrich-decoded-arglist-with-extra-keywords): New function, use
+	the secondary value of extra-keywords.
+	(arglist-for-insertion, complete-form): Use it here.
+	(remove-keywords-alist): New variable.
+	(remove-actual-args): When the keyword :test is provided, don't
+	suggest :test-not and vice versa.
+
+	* swank-backend.lisp (:swank-mop package): Export
+	finalize-inheritance.
+	
+2005-03-06  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp: Export *LOG-OUTPUT*.
+
+2005-03-05  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-net-sentinel): Always print a message when the
+	lisp disconnects.
+	(slime-inferior-lisp): Don't display the buffer.  Let callers do
+	that.
+	(slime): Display the inferior buffer here.
+	(slime-quit-lisp, slime-quit-sentinel): Use set a special sentinel
+	and do most of the cleanups there.
+	(slime-repl-sayoonara): Use slime-quit-lisp.
+	(slime-restart-inferior-lisp, slime-restart-inferior-lisp-aux)
+	(slime-restart-sentinel): Use a special sentinel to restart
+	processes.
+	(slime-hide-inferior-lisp-buffer): Do the windows arrangement a
+	bit differently. Related to restart-lisp.
+	(slime-repl-buffer): Take the connection as second optional
+	argument.  Useful for rearranging windows for dead processes.
+
+	* swank-allegro.lisp (call-with-debugging-environment)
+	(find-topframe): Hide the first 2 frames. Those are created
+	by swank-internal functions.
+
+2005-03-04  Antonio Menezes Leitao <aml at gia.ist.utl.pt>
+
+	* swank-allegro.lisp (process-fspec-for-allegro, toggle-trace):
+	Handle setf functions.
+	(tracedp): Fix free variable.
+
+ 	* slime.el (slime-trace-query): The :defgeneric query was bogus.
+	(slime-extract-context): Don't skip over the method name if we are
+	already at the end of the name.
+	
+2005-03-03  Nikodemus Siivola  <tsiivola at cc.hut.fi>
+
+	* swank-sbcl.lisp: Fixed for latest SBCL HEAD revision and
+	temporarily backwards-compatible with the current release.
+
+2005-03-02  Marco Baringer  <mb at bese.it>
+	
+	* swank-loader.lisp Look for a file in the same directory as
+	swank-loader.lisp called site-init.lisp. If it exists we load that
+	instead of attempting to load ~/.swank.lisp.
+	(user-init-file): Superseded by load-user-init-file.
+	(load-user-init-file): New function.
+	(load-site-init-file): New function.
+
+2005-03-01  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-who-bindings): Bind who-specializes to C-c W a.
+	(slime-extract-context): Renamed from name-context-at-point.
+	(slime-beginning-of-list): Renamed from out-first.
+	(slime-slime-parse-toplevel-form): Renamed from definition-name.
+	(slime-arglist-specializers): Renamed from parameter-specializers.
+	(slime-toggle-trace-function, slime-toggle-trace-defgeneric)
+	(slime-toggle-trace-defmethod, slime-toggle-trace-maybe-wherein)
+	(slime-toggle-trace-within): Deleted. Everything is now handled
+	by slime-trace-query.
+	(slime-calls-who): For symmetry with silme-who-calls.
+	(slime-edit-definition-with-etags): Better intergration with TAGS.
+	(slime-edit-definition-fallback-function): Mention it in the
+	docstring.
+
+	* swank-backend (calls-who, toggle-trace): New functions.
+	(toggle-trace-function, toggle-trace-generic-function-methods,
+	(toggle-trace-method,  toggle-trace-fdefinition-wherein): Replaced
+	by toggle-trace.
+
+	* swank.lisp (*sldb-printer-bindings*, *swank-pprint-bindings*):
+	New variables.  The alists replace the variables which where
+	previously hidden with the define-printer-variables macro.
+	(define-printer-variables, with-printer-settings): Deleted,
+	because the variable names where not visible in the source code.
+	(swank-toggle-trace): Renamed from toggle-trace-fdefinition.
+
+	* swank-cmucl.lisp, swank-lispworks, swank-sbcl.lisp,
+	swank-allegro.lisp (toggle-trace): Update tracing code for new
+	interface.
+
+2005-02-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-dispatch-event): Add :eval-no-wait and :eval
+	events.
+	(slime-eval-for-lisp): New function.
+	(sldb-buffers): Delete the variable.  Use buffer-list instead.
+
+	* swank.lisp: (eval-for-emacs): Use the new backend function
+	call-with-debugger-hook.
+	(eval-in-emacs): Cleaned up. Add support for synchronous RPCs.
+	(receive-eval-result): New function.
+	(dispatch-event, read-from-socket-io, send-to-socket-io): New
+	:eval event. Rename :%apply to :eval-no-wait.
+	(read-user-input-from-emacs, evaluate-in-emacs): Increment
+	*read-input-catch-tag* instead of re-binding it. Reduces the
+	danger of throwing to the wrong tag a bit.
+
+	* swank-backend.lisp (call-with-debugger-hook): New function.
+	Useful if the backend needs special incantations for BREAK.
+	(toggle-trace-function): Add a default implementation for simple
+	symbols.
+
+	* swank-lispworks.lisp (slime-env): New class. 
+	(call-with-debugger-hook): Use env:with-environment to pop up our
+	debugger on a BREAK.
+	(toggle-trace-method, parse-fspec, tracedp, toggle-trace):
+	Implement method tracing.
+
+	* swank-sbcl.lisp (call-with-debugger-hook): Bind
+	sb-ext:*invoke-debugger-hook* instead of setting it in
+	emacs-connected.
+	(emacs-connected): Deleted.
+
+	* swank-loader.lisp (compile-files-if-needed-serially): Reduce
+	verbosity by setting the :print argument for compile-file to nil.
+	
+2005-02-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-startup-animation, slime-repl-update-banner):
+	Put the animation back in to keep the kids quiet.
+	(slime-kill-without-query-p): Change default to nil.
+	(slime-eval-describe, slime-eval-region)
+	(slime-pprint-eval-last-expression): Fix typos in docstrings.
+	(slime-eval/compile-defun-dwim): Deleted. We never had a key
+	binding anyway.
+
+2005-02-22  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-complete-form): Emacs 20 compatibility fix.
+	(slime-repl-update-banner): Remove animation stuff.
+	(slime-startup-animation): Deleted.
+
+	* swank-lispworks.lisp (compute-applicable-methods-using-classes):
+	Implement it.
+
+2005-02-20  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Supersede the command slime-insert-arglist with the new command
+	slime-complete-form and bind it to C-c C-s.  The command completes
+	an incomplete form with a template for the missing arguments.
+	There is special code for discovering extra keywords of generic
+	functions and for handling make-instance. Examples:
+
+	  (subseq "abc" <C-c C-s>
+	    --inserts--> start [end])
+	  (find 17 <C-c C-s>
+	    --inserts--> sequence :from-end from-end :test test
+	                 :test-not test-not :start start :end end :key key)
+	  (find 17 '(17 18 19) :test #'= <C-c C-s>
+	    --inserts--> :from-end from-end
+	                 :test-not test-not :start start :end end :key key)
+	  (defclass foo () ((bar :initarg :bar)))
+	  (defmethod initialize-instance :after ((object foo) &key blub))
+	  (make-instance 'foo <C-c C-s>
+	    --inserts--> :bar bar :blub blub initargs...)
+	
+	* swank.lisp (arglist): New struct for storing decoded arglists.
+	(decode-arglist): New function.
+	(arglist-keywords, methods-keywords, generic-function-keywords,
+	applicable-methods-keywords): New functions.
+	(decoded-arglist-to-template-string,
+	print-decoded-arglist-as-template): New functions.
+	(arglist-to-template-string): Rewrite using above functions.
+	(remove-actual-args): New function.
+	(complete-form): New slimefun.
+	
+	* swank.lisp (extra-keywords): New generic function.
+	
+	* swank-backend.lisp (:swank-mop package):
+	Export compute-applicable-methods-using-classes.
+	
+	* swank.lisp (arglist-for-insertion): Use extra-keywords to
+	enrich the list of keywords.
+	
+	* swank.lisp (valid-operator-symbol-p): New function.
+	(valid-operator-name-p): Use valid-operator-symbol-p.
+	
+	* slime.el (slime-complete-form): New command.
+	(slime-keys): Bind C-c C-s to slime-complete-form rather than
+	slime-insert-arglist.
+	
+2005-02-18  Antonio Menezes Leitao  <aml at gia.ist.utl.pt>
+
+	Improve the trace mechanism (on lisps that support it). SLIME is
+	now able to trace/untrace flet/labels functions, methods and, of
+	course, regular and generic functions.
+
+	In the process support for sending code to emacs form the lisp was
+	added. The code, elisp forms, is sent over the wire like normal
+	lisp code, evaluated in emacs and the return value is returned
+	back to the lisp.
+
+	* slime.el (slime-dispatch-event): Added the :evaluale-in-emacs
+	dispatch state which simply parses the message and class
+	evaluate-in-emacs.
+	(evaluate-in-emacs): New function.
+	(complete-name-context-at-point, name-context-at-point, out-first,
+	definition-name, parameter-specializers,
+	slime-toggle-trace-fdefinition, slime-toggle-trace-function,
+	slime-toggle-trace-defgeneric, slime-toggle-trace-defmethod,
+	slime-toggle-trace-maybe-wherein, slime-toggle-trace-within): New
+	functions implementing the new intelligent slime trace.
+
+	* swank-backend.lisp (toggle-trace-function,
+	toggle-trace-generic-function-methods, toggle-trace-method,
+	toggle-trace-fdefinition-wherein,
+	toggle-trace-fdefinition-within): New backend functions
+	for the new trace facility.
+
+	* swank.lisp (dispatch-event): Handle the :evaluate-in-emacs
+	message type.
+	(evaluate-in-emacs): New function.
+
+	* swank-allegro.lisp (toggle-trace-generic-function-methods,
+	toggle-trace, toggle-trace-function, toggle-trace-method,
+	toggle-trace-fdefinition-wherein,
+	toggle-trace-fdefinition-within): Implement.
+	(process-fspec-for-allegro): New function.
+	
+	* swank-cmucl.lisp (toggle-trace-generic-function-methods,
+	toggle-trace-function, toggle-trace-method,
+	toggle-trace-fdefinition-wherein): Implement.	
+	(toggle-trace, process-fspec): New functions.
+
+	* swank-sbcl.lisp (toggle-trace-generic-function-methods,
+	toggle-trace-function, toggle-trace-method,
+	toggle-trace-fdefinition-wherein): Implement.
+	(toggle-trace, process-fspec): New functions.
+	
+2005-02-02  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Require the timer package explicitly.
+
+2005-02-02  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-repl-send-input): Move some properties
+	of old REPL input (e.g. read-only) from text properties into an
+	overlay, so that kill/yank will leave them behind. Left
+	`slime-repl-old-input' as a text properties because it's more
+	convenient to lookup that way.
+	(slime-repl-return): Ignore `slime-repl-old-input' property if the
+	point is in front of the current REPL prompt, i.e. if the user has
+	copy&pasted some old REPL input into the current input area.
+
+2005-01-30  Bryan O'Connor <bryan-slime at lunch.org>
+
+	* slime.el (slime-goto-location-position): Changed the regexp to
+	require the function-name to be followed by a
+	non-symbol-constituent character \S_.  Previously, a function-name
+	of "find" first matched find-if-not if it occured earlier in the
+	file.
+
+2005-01-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-busy-p): Ignore debugged continuations to enable
+	arglist lookup while debugging.  Suggested by Lynn Quam.
+	(sldb-continuations): New buffer local variable in sldb buffers to
+	keep track of debugged continuations.
+	(sldb-debugged-continuations): New function.
+	(sldb-buffers): Renamed from sldb-remove-killed-buffers.
+	(slime-eval-print): New function to insert the stream output and
+	the result of an evaluation in the current buffer.
+	(slime-eval-print-last-expression): Use it.
+	(slime-interactive-eval): Use slime-eval-print when a prefix
+	argument was given.
+
+	* swank.lisp (*pending-continuations*, eval-in-emacs)
+	(debugger-info-for-emacs): Keep track of debugged continuation the
+	new variable *pending-continuations* and include the list of
+	active continuations in the debugger info for Emacs.
+	(eval-and-grab-output): New function.  Used by slime-eval-print.
+	(*log-output*): Renamed from *log-io*.  Use *standard-error* as
+	initial value instead of *terminal-io*.  CMUCL opens its own tty
+	and that makes it hard to redirect to output with a shell.
+	*standard-error* writes its output to file descriptor 2.
+	(*canonical-package-nicknames*): Fix typo.
+
+2005-01-20  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (parse-symbol): Don't break if the package doesn't
+	exist.  Reported by Lynn Quam.
+	
+2005-01-20  Ian Eslick <eslick at csail.mit.edu>
+
+	* swank-allegro.lisp (restart-frame): Handle frames with arguments
+	better.
+
+2005-01-20  Edi Weitz  <edi at agharta.de>
+
+	* swank-allegro.lisp (handle-undefined-functions-warning): Prevent
+	breakage if the undefined function is called at multiple
+	locations.
+
+2005-01-19  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-gray.lisp (stream-unread-char): If the char argument
+	doesn't match the contents in the buffer, ignore it and emit a
+	warning instead.
+
+2005-01-19  Utz-Uwe Haus <haus+slime at merkur.math.uni-magdeburg.de>
+
+	* swank-cmucl.lisp (breakpoint): Add a slot for return values to
+	make return values inspectable in the debugger.
+	(signal-breakpoint): Initialize the new slot.
+
+2005-01-19  Matthias Koeppe <mkoeppe at merkur.math.uni-magdeburg.de>
+
+	* slime.el (slime-insert-arglist): Inserts a template for a
+	function call instead of the plain arglist; this makes a
+	difference for functions with optional and keyword arguments.
+
+	* swank.lisp (arglist-to-template-string): New function.
+	(arglist-for-insertion): Use it
+	(decode-keyword-arg, decode-optional-arg): New functions.
+	
+2005-01-19  Lars Magne Ingebrigtsen  <larsi at gnus.org>
+
+	* slime.el (slime-header-line-p): Customize variable to
+	enable/disable the header-line in the REPL.
+
+2005-01-18  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-complete-symbol*-fancy): New variable to enable
+	extra bells and whistles with slime-complete-symbol*. Currently
+	controls whether to use arglists semantically. Default is t.
+	(slime-complete-symbol*-fancy-bit): Factored out this function.
+	Only do "semantic" completion when the symbol is in
+	function-position, avoid interning argument names in Emacs, and
+	don't display arglists if the minibuffer is active.
+
+2005-01-14  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-repl-send-input): Make old input read-only using
+	an overlay instead of a text property. This way if you copy&paste
+	the input elsewhere it will become editable (overlay is associated
+	with the buffer region and not the text).
+
+2005-01-14  Edi Weitz  <edi at agharta.de>
+
+        * slime.el (slime-complete-symbol*): Maybe insert closing
+        parenthesis or space (depending on arglist) after symbol
+        completion has finished.  Optionally also show arglist.
+
+2005-01-13  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (create-socket): The byte-order of the :host
+	argument for CREATE-INET-LISTENER was changed in the Jan 2005
+	snapshot.  Test whether the symbol 'ext:socket-error exists to
+	decide if we are in a older version.
+	(resolve-hostname): Return the address in host byte-order.
+
+2005-01-12  Robert Lehr <bozzio at the-lehrs.com>
+
+	* slime.el (slime-changelog-date): Return nil if the ChangLog file
+	doesn't exits.
+	(slime-repl-update-banner): Write "ChangeLog file not found" if
+	the ChangeLog doesn't exist.
+
+2005-01-12  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime.el (slime-inspector-operate-on-click): New command for
+	inspecting the value value at the clicked-at position or invoking
+	an inspector action.
+	(slime-inspector-mode-map): Bind it to mouse-2.
+	(slime-inspector-insert-ispec): Add mouse-face properties for
+	clickable values and action buttons.
+
+2005-01-12  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*default-worker-thread-bindings*): New variable to
+	initialize dynamic variables in worker threads.
+	(spawn-worker-thread, call-with-bindings): New helper functions.
+	(thread-for-evaluation): Use them.
+
+2005-01-10  Utz-Uwe Haus <haus+slime at merkur.math.uni-magdeburg.de>
+
+	* swank-sbcl.lisp (profile-package): Add implementation for SBCL.
+
+2005-01-10  Eduardo Muñoz <emufer at terra.es>
+
+	* swank.lisp (inspect-for-emacs-list): LispWorks has a low args
+	limit for apply: use reduce instead of apply.
+
+2005-01-10  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-conservative-indentation): The default is now
+	nil.  Suggested by Travis Cross.
+
+2005-01-10  Matthias Koeppe <mkoeppe at merkur.math.uni-magdeburg.de>
+
+	* slime.el (slime-inspector-next-inspectable-object): Accept a
+	prefix argument and make wrapping around more reliable.  The code
+	is adapted from `widget-move'.
+	(slime-inspector-previous-inspectable-object): New command.
+	(slime-inspector-mode-map): Bind to S-TAB.
+	
+2004-12-16  Martin Simmons <martin at xanalys.com>
+
+	* swank-lispworks.lisp (create-socket): Work around bug in
+	comm::create-tcp-socket-for-service on Mac OS LW 4.3.
+
+2004-12-16  Edi Weitz  <edi at agharta.de>
+
+	* slime.el (slime-complete-symbol*): Bind
+	comint-completion-addsuffix so unambiguous or exact completion
+	closes the string automatically.
+
+2004-12-16  Matthias Koeppe <mkoeppe at merkur.math.uni-magdeburg.de>
+
+	* slime.el (slime-keys): Bind M-* to
+	slime-pop-find-definition-stack for compatibility with standard
+	Emacs conventions.
+
+2004-12-16  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-source-path-parser.lisp (read-source-form): New function
+	which uses *read-suppress* properly.  Common code from
+	source-path-stream-position and form-number-stream-position.
+	(source-path-stream-position): Use it.
+
+	* swank-cmucl.lisp (form-number-stream-position): Use
+	read-source-form.
+
+	* swank.lisp (frame-for-emacs): Print the frame number a little
+	nicer with ~2D.
+
+2004-12-15  Matthias Koeppe  <mkoeppe at merkur.math.uni-magdeburg.de>
+
+	* slime.el (slime-lisp-modes): New variable to make C-c C-k
+	customizable and usable in scheme-mode.
+	(slime-compile-file): Use it.
+
+2004-12-15  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp, swank-backend.lisp (frame-package): Delete it.
+	Include the package name for local variables because it is utterly
+	confusing if `eval-in-frame' doesn't work due to missing package
+	prefixes.
+	
+	* swank-source-path-parser.lisp (source-path-stream-position):
+	Bind *read-suppress* to nil before calling
+	read-and-record-source-map.
+
+	* swank-clisp.lisp (*buffer-name*, *buffer-offset*): Move
+	definitions upward before the first use.
+
+2004-12-15  Bryan O'Connor <bryan-slime at lunch.org>
+
+	* slime.el (slime-edit-definition): Switch to the other frame if
+	the `where' is 'frame.
+	(slime-edit-definition-other-frame): New function.
+
+2004-12-15  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-send-input): Make the input read-only to
+	avoid confusion.
+	(slime-make-region-read-only): New function.
+	
+2004-12-13  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-mode-map): Bind <home> to slime-repl-bol.
+	Suggested by Chris Capel.
+	(slime-repl-grab-old-input): Remove the 'old-input text-property
+	from the copied text.  Reported by Tim Oates.
+	(slime-repl-grab-old-input): Append the old input to the current
+	input by default.  If the new `replace' argument is true, replace
+	the current input.  Suggested by Antonio Menezes Leitao.
+	(slime-repl-return): Pass the prefix argument to
+	slime-repl-grab-old-input.
+
+2004-12-09  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (*sldb-print-pretty*, *sldb-print-circle*)
+	(*sldb-print-length*, *sldb-print-level*, *sldb-print-lines*)
+	(*sldb-print-pprint-dispatch*): Export those symbols.
+
+2004-12-05  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-global-variable-name-p): Also return true for
+	names of constants like +foo+.  Suggested by Christian Lynbech.
+
+	* swank-allegro.lisp (handle-compiler-warning): Handle
+	undefined-functions warnings by looking the fromat-arguments of
+	the condition.
+	(compiler-undefined-functions-called-warning-p)
+	(location-for-warning, handle-undefined-functions-warning): New
+	functions.
+
+	* swank-cmucl.lisp (*install-gc-hooks*): New user variable.
+	(sending-safe-p): New predicate.
+	(pre-gc-hook, post-gc-hook): Use it.
+
+	* swank.lisp (eval-region): Use a simple loop.
+
+2004-12-02  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp: (inspect-for-emacs (symbol)): Handle non-interned
+	symbols.
+
+	* slime.el (slime-repl-clear-buffer, slime-repl-clear-output): Fix
+	docstrings.
+
+2004-11-29  Lynn Quam <quam at ai.sri.com>
+
+	* slime.el (slime-global-variable-name-p): Allow optional
+	"<package-name>:" or "<package-name>::".
+
+2004-11-29  Chris Capel <pdf23ds at gmail.com>
+
+	* swank.lisp (macro-indentation): Ignore &whole, &aux, and
+	&environment args.
+
+2004-11-29  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-repl-wrap-history): New user variable.
+	(slime-repl-history-replace): Implement wrap around.
+	(slime-repl-easy-menu): Fix binding for "Next Input".  Reported by
+	Surendra Singhi.
+
+	* swank-lispworks.lisp (list-callers-internal): Return the
+	function if dspec:object-dspec returns nil.
+	(xref-results): Previously, functions for which
+	dspec:dspec-definition-locations returned nil were ignored.
+	Include them with a unknown source-location.
+
+	* swank-abcl.lisp, swank-allegro.lisp, swank-clisp.lisp,
+	swank-cmucl.lisp, swank-openmcl.lisp, swank-sbcl.lisp,
+	swank-lispworks (accept-connection): The :external-format argument
+	defaults now to :iso-latin-1-unix.
+	
+2004-11-26  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-cmucl.lisp (read-into-simple-string): Use #-cmu19 instead
+	of #+cmu18e.
+
+2004-11-25  Chris Capel <pdf23ds at gmail.com>
+
+	* slime.el (slime-indent-and-complete-symbol): Echo the arglist if
+	there's no symbol before point.  Don't complete after parens.
+	(slime-echo-arglist): Factorized from slime-space.
+	(slime-space): Use it.
+	(slime-repl-history-replace): Clear the input at the end of the
+	history.
+	
+	* swank.lisp (arglist-to-string): Don't show &whole, &aux and
+	&environment args.
+	(clean-arglist): New function.
+
+2004-11-25  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-net-coding-system): Emacs does funky encoding
+	for `raw-text-unix' use `binary' instead.
+	(slime-safe-encoding-p): New function.
+	(slime-net-send): Use it and don't try to send stuff which can't
+	be decoded by Lisp.
+	(slime-inferior-lisp-program-history): XEmacs compatibility:
+	declare it as a variable.
+	(slime-xref-mode): In Emacs 21, set delayed-mode-hooks to nil
+	because we don't want to run the lisp-mode-hook.  Reported by
+	Chris Capel.
+
+	* swank.lisp (dispatch-loop): Catch errors and close the
+	connection.  It's almost impossible to run the debugger inside the
+	control-thread, so let it crash instead.  A backtrace would be
+	nice, though.
+	(cleanup-connection-threads): Can now be called in the
+	control-thread.  Add a check to avoid thread suicide.
+	(start-swank-server-in-thread): Fix the call to start-server.
+
+	* swank-sbcl.lisp (%thread-state-slot, %thread-state): Refactored
+	from thread-status.
+	(thread-status): Use it.
+	(all-threads): Exclude zombies.
+
+2004-11-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-start-and-load): Use vanilla comint instead of
+	inf-lisp.  Let's try that for a while.
+	(slime): Ask for the coding system when invoked with C-u C-u.
+	(slime-net-coding-system, slime-net-valid-coding-systems): Add
+	some alternatives for older Emacsen.
+	(slime-find-buffer-package): Skip quotes.  Old code looks
+	sometimes like (in-package 'foo).
+	(slime-repl-mode-map): Inhibit C-c C-z.  Avoids accidental loading
+	inf-lisp.
+	(slime-net-coding-system): Use find-coding-system in XEmacs.
+	coding-system-p means something different here.
+	(slime-repl-mode-map): XEmacs compatibility: use (kbd "C-<up>")
+	instead of [C-up].
+
+	* swank.lisp (inspect-for-emacs-list): subseq on improper lists
+	breaks in Lispworks. Handle that case better.
+
+	* swank-sbcl.lisp (inspect-for-emacs)[code-component]: Disassemble
+	code-components too.
+
+	* swank-backend.lisp (import-swank-mop-symbols): Better error
+	message for the assertion.
+
+	* swank-cmucl.lisp (debug-var-value): Return #:invalid or
+	#:unknown instead of :<not-available>.
+	(swank-compile-file): Load the fasl file only if load-p is true.
+	(inspect-for-emacs, inspect-alien-record, inspect-alien-pointer):
+	Add inspector support for some alien types.
+
+	* swank-lispworks.lisp (emacs-connected): Set the sigint handler
+	only for single threaded operation. I.e. when
+	*communication-style* is nil.
+
+	* swank-allegro.lisp (set-external-format): New function.  Use LF
+	as eol mark.
+	(call-with-compilation-hooks): Trap compiler-notes too.
+
+2004-11-24  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-repl-mode-map): Add C-up and C-down to move
+	through history. Consistent with comint-mode.
+	(slime-repl-mode-map): Add slime-load-file on `C-c C-l' and
+	slime-compile-file on `C-c C-k'. This is mostly to override
+	unwanted inf-lisp bindings in lisp-mode-map.
+	(slime-load-file): Handle (buffer-file-name) being nil.
+
+2004-11-20  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (make-socket-io-stream): Add some #+sb-unicode.
+
+2004-11-20  Travis Cross <travis at crosswirecorp.com>
+
+	* swank-sbcl.lisp (thread-status): Fix unbalanced parenthesis.
+
+2004-11-20  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (make-stream-interactive): Only add ouptut
+	streams (subclasses of ccl:fundamental-output-stream) to
+	ccl::*auto-flush-streams*.
+	
+2004-11-19  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-net-coding-system): New variable.  Specifies the
+	coding system to use for network communication.  The default is
+	iso-latin-1 and should work for all Lisps.  Only a small set of
+	coding systems is currently supported.
+	(slime-net-valid-coding-systems): New variable.  A list of coding
+	systems which may be used.
+	(slime-check-coding-system, slime-coding-system-mulibyte-p)
+	(slime-coding-system-cl-name): New utility function for coding
+	systems.
+	(slime-net-connect, slime-make-net-buffer,
+	slime-open-stream-to-lisp): Use it.
+	(slime-net-decode-length, slime-net-encode-length): Renamed from
+	slime-net-read3 and slime-net-enc3.  The length is now encoded as
+	a 6 char hex string.
+
+	* swank.lisp (*coding-system*): New variable.
+	(start-server): Accept external-format as argument.
+	(create-server, create-swank-server, setup-server)
+	(serve-connection, open-dedicated-output-stream)
+	(create-connection): Ditto.
+	(defstruct connection): Add external-format slot.
+	(decode-message-length): New function for new length encoding.
+	(decode-message): Use it.
+	(encode-message): Use new encoding.
+
+	* swank-cmucl.lisp (accept-connection): Accept external-format
+	argument.
+	(inspect-for-emacs): Add CMUCL specific versions for array and
+	vectors.
+
+	* swank-sbcl.lisp, swank-openmcl.lisp, swank-lispworks.lisp,
+	swank-clisp.lisp, swank-backend.lisp, swank-allegro.lisp,
+	swank-abcl.lisp (accept-connection): Accept :external-format as
+	argument.
+
+2004-11-19  Matthew Danish <mrd+nospam at cmu.edu>
+	
+	* swank-allegro.lisp: (count-cr): New function. Convert
+	file-offsets to match Emacs' eol-conventions.
+	(find-definition-in-file): Use it.
+
+	* slime.el (slime-insert-xrefs): Display the multi-line label much
+	more cleanly.
+	
+2004-11-19  Helmut Eller  <heller at common-lisp.net>
+	
+	* swank-sbcl.lisp (thread-status): Decode the thread-state-slot
+	instead of returning ???.
+
+	* swank-allegro.lisp (swank-mop:slot-definition-documentation):
+	ACL 7 says documentation should have 2 args. So, pass t as second
+	argument.
+	(fspec-primary-name): Recurse until we have a symbol.
+	(allegro-inspect): New function.  Mostly reverse engineered from
+	ACL's native inspector.
+	(inspect-for-emacs (t), inspect-for-emacs (function)): Use it.
+
+	* swank.lisp (inspect-for-emacs array): Use row-major-aref instead
+	of a displaced array.  I hope that does the same.
+	(inspect-for-emacs integer): Ignore errors in
+	decode-universal-time.  Negative values and, in SBCL, also small
+	values cannot be decoded.
+	(list-threads): Include the thread-id. Useful for SLIME debugging.
+
+	* slime.el (slime-list-threads, slime-thread-insert): Show the
+	thread-id.
+	(slime-thread-control-mode-map): Remove the binding for the
+	no-longer-existent slime-thread-goahead command.
+	
+2004-11-18  Alexey Dejneka <adejneka at comail.ru>
+
+	* swank.lisp (inspect-for-emacs): Fix bug in handling of arrays
+	with fill-pointers.
+
+2004-11-15  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: The REPL commands ,quit and ,sayoonara are now
+	distinct.  Previously Quit killed all Lisps an all buffers.  The
+	new Quit command kills only the current Lisp.
+	(slime-quit-lisp): New function.
+	(repl-command quit): Use it. Don't delete all buffers.
+	(repl-command sayoonara): No longer an alias for ,quit.
+	(slime-connection-list-mode-map): Bind C-k to slime-quit-lisp.
+	(slime-communication-style): New connection variable.
+	(slime-use-sigint-for-interrupt): Is no longer a connection local
+	variable.  It's derived from the new slime-communication-style.
+	(slime-inhibit-pipelining): New user option.
+	(slime-background-activities-enabled-p): New predicate to control
+	various background activities like autodoc and arglist fetching.
+	(slime-space, slime-autodoc-message-ok-p): Use it.
+	(slime-search-call-site): Use hints provided to search a call-site
+	in a defun.  Useful for the show-frame-source command.
+	(slime-goto-source-location): Use it.
+	(slime-quit): Deleted, as it was broken.  May come back later.
+	(slime-inspector-label-face, slime-inspector-value-face)
+	(slime-inspector-action-face, slime-reader-conditional-face):
+	Provide better defaults for Emacsen which don't support :inherited
+	faces.
+
+	* swank-backend.lisp (emacs-connected): Don't pass the stream as
+	argument.  make-stream-interactive is a better place for setting
+	buffering options.
+
+	* swank-cmucl.lisp (emacs-connected): Install GC hooks to display
+	GC messages in the echo area.
+	(sos/misc :flush-output): There seem to be funny signal safety
+	issues if the dedicated output stream is not used.  So, lets first
+	reset the buffer index before sending the buffer to the underlying
+	stream.
+
+	* swank-lispworks.lisp (frame-source-location-for-emacs): Pass the
+	function name of the next (newer) frame as a hint to Emacs.  This
+	way we can highlight the call site in some cases, instead of the
+	entire defun.
+	(frame-location): Renamed from function-name-location.  The
+	argument is now a dspec, not only a name. Also include hints for
+	Emacs.
+	(lispworks-inspect): Simplified from old code.
+	(inspect-for-emacs): Use it for also for simple functions.
+	(emacs-connected, make-stream-interactive): Move the
+	soft-force-output stuff to make-stream-interactive.
+
+	* swank-abcl.lisp (emacs-connected): Deleted.  The default
+	implementation should be good enough.
+
+	* swank-sbcl.lisp (emacs-connected): Updated for new interface.
+
+	* swank-openmcl.lisp (emacs-connected, make-stream-interactive):
+	Move buffering stuff to make-stream-interactive.
+
+	* swank.lisp (defstruct connection): Add new slot:
+	communication-style for convenience.
+	(create-connection): Initialize the new slot.
+	(connection-info): Send the communication-style to Emacs.
+	(install-fd-handler, simple-serve-requests): Sending
+	:use-sigint-for-interrupt is no longer necessary.
+
+2004-11-11  Raymond Toy <raymond.toy at ericsson.com>
+
+	* slime.el (slime-activate-font-lock-magic): Add XEmacs support.
+	(slime-reader-conditional-face): New face.
+
+2004-11-10  Marco Baringer  <mb at bese.it>
+
+	* swank-backend.lisp (definterface): Eliminate unused variable
+	received-args.
+	(emacs-connected, make-stream-interactive, condition-references,
+	condition-extras, buffer-first-change): Add (declare (ignore X))
+	for unused arguments in default implementations.
+	(inspect-for-emacs): Remove (declare (ignore)) for inexistent
+	variable inspection-mode. Added T qualifiers in method arguments.
+
+	* swank-openmcl.lisp (inspect-for-emacs): Use definterface so
+	SLIME knows we implement this.
+	(arglist function): Use ccl:arglist, not ccl::arglist-from-map.
+	(inspect-for-emacs): Added support for inspecting the uvector
+	objects under lisp datums.
+	
+2004-11-09  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (features-for-emacs): New function to avoid
+	keyword/string confusion.  Case doesn't matter since Emacs will
+	downcase them anyway.
+	(connection-info, sync-features-to-emacs): Use it.  Should fix
+	highlighting bug reported by Edi Weitz.
+
+	* slime.el (slime-eval-feature-conditional): Convert AND, OR, and
+	NOT to lowercase keywords.
+	(slime-net-read3): Silly optimization: give char-after the offset
+	as argument to avoid save-excursion and forward-char.
+
+2004-11-07  Brian Downing  <bdowning at lavos.net>
+
+	* slime.el (slime-fuzzy-explanation): Added line to describe
+	flags (:boundp, :fboundp, :macro, etc), which are now reported in
+	the fuzzy-completion output.
+	(slime-fuzzy-insert-completion-choice): Added flags.
+	(slime-fuzzy-choices-buffer): Added flags header.
+
+	* swank.lisp (fuzzy-completions): Changed docstring to describe
+	new flags in the completion results.
+	(convert-fuzzy-completion-result): New function to marshall the
+	results from the completion core into something Emacs is
+	expecting.  Added flags.
+	(fuzzy-completion-set): Use the above.
+	(compute-completion): Removed.
+	(score-completion): Cleaned up a little bit.
+	(highlight-completion): Use destructive nstring-upcase.
+
+2004-11-01  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-easy-menu): Add item for
+	slime-update-indentation.  Suggested by Lynn Quam.
+	(slime-severity-faceslime-show-note-counts)
+	(slime-most-severe, slime-choose-overlay-region): Handle
+	read-errors.
+	(slime-show-buffer-position): New function.
+	(slime-show-source-location): Use it.
+
+	* swank-backend.lisp (deftype severity): Add read-errors.
+
+	* swank-cmucl.lisp (severity-for-emacs): Special case read-errors.
+	(read-error-location): Add the offset to the buffer start.
+
+	* swank.lisp (assign-index): Avoid linear search.
+
+2004-10-30  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-source-path-parser.lisp (source-path-stream-position):
+	Bind *read-suppress* only as long as we skip over forms.  The last
+	toplevel form in the path is read with *read-suppress* = nil
+	because in newer versions of CMUCL and SBCL read will return nil
+	if *read-suppress* is t.
+
+2004-10-28  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-clisp.lisp: Ups. Undo previous change.
+
+	* swank-clisp.lisp: Add workaround for CLISP's broken control
+	string parser.
+
+	* swank-cmucl.lisp (set-step-breakpoints): Handle breakpoints at
+	single-return points in escaped frames better.  Previously we
+	tried to set a breakpoint at the current position and consequently
+	was only hit during the next call.
+	(inspect-for-emacs)[function]: Call the next method only for
+	funcallable instances.
+	(profile-report, profile-reset, unprofile-all): We have to use
+	eval because the macro expansion depends on the value of
+	*timed-functions*.  Reported by Chisheng Huang.
+
+	* slime.el (slime-space): Call slime-message in the right buffer,
+	so that after-command hooks are added in the right buffer.
+	Reported by Juho Snellman.
+	(slime-dispatch-event): Accept stepping flag.
+	(sldb-setup): Don't query when entering a recursive edit.
+	(sldb-exit): Don't kill the buffer if we are in stepping mode.
+	(slime-inspector-insert-ispec): New function.
+	(slime-open-inspector): Use it.
+	(slime-inspector-operate-on-point): Simplified.
+	(test interactive-eval): Fix test case.
+	(slime-kill-all-buffers): More regexp kludges.  From Bill Clementson.
+
+	* swank-backend.lisp (activate-stepping): New function.
+
+	* swank.lisp (*sldb-stepping-p*): New variable.  Used to tell
+	emacs that the debugger buffer should not be closed even if we
+	unwind.
+	(debug-in-emacs): Use it.
+	(sldb-step): Moved to the front end.
+	(inspector-princ, method-specializers-for-inspect): Simplified.
+	(methods-by-applicability): Use a simpler algorithm. I doubt there
+	is much difference in practice.
+	(inspect-for-emacs)[symbol, function, standard-generic-function]
+	[standard-method]: Use less than 80 columns.
+	(inspector-call-nth-action): Don't accept &rest args.  Was never
+	used.
+	(inspect-for-emacs) [integer]: Fix control string.  Thanks to CSR
+	for pointing it out.
+
+2004-10-27  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-sbcl.lisp (signal-compiler-condition): Actually delete one
+	of the reader-conditionalized forms.
+
+2004-10-26  Helmut Eller  <heller at common-lisp.net>
+
+	* cl-indent.el: Add indentation specs for some missing CL symbols.
+	(lisp-prefix-match-indentation): Change default to
+	nil to avoid confusion for people who don't care about the issue.
+
+	* swank-sbcl.lisp (signal-compiler-condition): Remove reader
+	conditionals as the current code doesn't work in any SBCL before
+	0.8.13 anyway.
+
+	* swank-source-path-parser.lisp: Remove workarounds for SBCL bugs.
+	The bugs are fixed in the versions we support.
+
+	* swank-cmucl.lisp (read-error-location)
+	(signal-compiler-condition): Handle read-errors.
+	(swank-compile-file): Don't load the fasl file if there was an
+	error.
+
+	* swank.lisp (define-printer-variables): Handle doc strings
+	properly.
+	(*sldb-pprint-dispatch*): Initialize it with the default dispatch
+	table.
+
+	* slime.el (slime-init-command): New function to send the command
+	to load swank.  Having a separate function for the task should
+	make it easier to start a Lips with a preloaded swank.
+	(slime-maybe-start-lisp): Use it.
+	(slime-maybe-start-multiprocessing): Deleted.
+	(slime-repl-buffer): Include the name of the implementation.
+	(slime-set-default-directory)
+	(slime-sync-package-and-default-directory): Translate filenames.
+
+2004-10-25  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (inspect-for-emacs array): Properly deal with arrays
+	without fill pointers.
+	(inspect-for-emacs function): Show function-lambda-expression
+	when available.
+
+	* swank-openmcl.lisp (specializer-name): New function.
+	(who-specializes): Use it.
+	(maybe-method-location): Use it.
+	(function-source-location): Use it.
+
+	* swank-cmucl.lisp (inspect-for-emacs function): Use next
+	method's values and simply add cmucl specific details.
+
+	* slime.el (slime-repl-defparameter): Change default value to "*".
+	
+2004-10-25  Thomas Schilling <tjs_ng at yahoo.de>
+
+	* swank-allegro.lisp (inspect-for-emacs): Use
+	excl::external-fn_symdef to get the function documentation.
+
+	* swank.lisp (inspect-for-emacs): Order generic function's methods
+	and show abbreviated docs for methods.
+	(abbrev-doc): New function.
+	(methods-by-applicability): New function.
+	(*gf-method-getter*): New variable.
+	
+2004-10-19  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-show-source-location): Call `push-mark' to push
+	the source position onto the global mark ring.
+
+2004-10-19  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (define-printer-variables): NIL is not a valid
+	docstring.  Reported by Alain Picard.
+	(printer-variables sldb-print): Include print-gensym,
+	pprint-dispatch, base, radix, array, and lines.
+
+2004-10-17  Luke Gorrie  <luke at synap.se>
+
+	* slime.el (slime-message): Use slime-typeout-frame if available.
+
+2004-10-17  Helmut Eller  <heller at common-lisp.net>
+
+	* cl-indent.el: Our local copy.  Should eventually be merged the
+	file with in the main distribution.
+
+	* slime.el: (slime-find-buffer-package-function): New variable to
+	allow customization for unusal syntax.
+	(slime-maybe-rearrange-inferior-lisp): Removed unused function.
+	(slime-set-inferior-process): Non-macro version to make
+	byte-compiler happy.  Reported by Raymond Wiker.
+	(slime-maybe-start-lisp): Use it.
+	(slime-sync-package-and-default-directory): Synch the
+	default-directory in the REPL buffer too.
+	(slime-goto-connection): Close the connection list window.
+	Suggested by Andras Simon.
+	(slime-repl-clear-buffer): Place point after the prompt.
+	(selector-method ?i): Use slime-process to switch to the right
+	buffer.
+	(slime-background-message): Do nothing if the minibuffer is
+	active.
+	(slime-indent-and-complete-symbol): Don't indent if we at the same
+	line as the prompt.
+
+	* swank.lisp (*sldb-pprint-frames*): Renamed to
+	*sldb-print-pretty*.
+	(*sldb-print-level*, *sldb-print-length*, *sldb-print-circle*)
+	(*sldb-print-readbly): Group of new variables to customize
+	printing in the debugger.  The default values should be safe.
+	(define-printer-variables, with-printer-settings): New macros to
+	make defining and binding groups of printer variables easier.
+	(inspect-for-emacs-list): Fix bug with circular lists and only
+	shows the first 40 elements.
+	(inspect-for-emacs): Various cleanups.
+	(all-qualified-readnames): Removed. It was not needed because
+	common-lisp-indent-function strips of any package prefix and
+	downcases the symbol anyway.
+ 	(printer-variables sldb-print): Ooops. Better use sldb-print as prefix
+	than sldb alone.  *sldb-level* was already defined.
+
+	* swank-cmucl.lisp (inspect-for-emacs (code-component)):
+	Disassemble the memory region if there's not enough debug info.
+
+2004-10-17  Jan Rychter  <jan at rychter.com>
+
+	* swank-cmucl.lisp (return-from-frame): Add it.
+
+2004-10-11  Thomas F. Burdick  <tfb at OCF.Berkeley.EDU>
+
+	* swank-sbcl.lisp (function-definitions): Find compiler macros, too.
+	(find-defintions, compiler-definitions)
+	(optimizer-definitions, transform-definitions): Add compiler
+	transformers and optimizers to the list of definitions.
+
+2004-10-07  Peter Seibel  <peter at javamonkey.com>
+
+	* swank.lisp (spawn-threads-for-connection): Bind *debugger-hook*
+	instead of SETF'ing it.
+
+2004-10-06  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (update-indentation/delta-for-emacs): Configure Emacs
+	indentation settings not just for the symbol name but for all
+	package-qualified forms of it as well.
+
+	* doc/slime.texi (Credits): Updated the credits list to include
+	more Lisp implementors who're also SLIME hackers.
+
+2004-10-05  Luke Gorrie  <luke at synap.se>
+
+	* swank.lisp (arglist-for-echo-area): Handle errors and return a
+	message.
+	(parse-symbol): Recognise an empty package name as the KEYWORD
+	package.
+
+2004-10-03  Reini Urban <rurban at x-ray.at>
+
+	* swank-clisp.lisp (getpid)[win32]: Use
+	win32:|GetCurrentProcessId|.
+
+2004-10-03  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el: Reduce dependency on inf-lisp internals. Make it
+	possible to start the inferior lisp in a buffer different from
+	"*inferior-lisp*".
+	(slime): Parse the command argument explicitly and don't rely on
+	`inferior-lisp'.  Don't close all connections, but only the one
+	for the inferior lisp buffer we are using.
+	(slime-maybe-start-lisp): Take the command and buffer as argument.
+	Decide here whether we should start start a new processwe or just
+	disconnect and reconnect .
+	(slime-start-lisp): Load verbosely.
+	(slime-inferior-lisp): New function.  Replaces call to
+	`inferior-lisp'.
+	(slime-inferior-connect, slime-start-swank-server): Take the
+	inferior process as argument
+	(slime-read-port-and-connect): Set the slime-inferior-process
+	variable in the new connection.
+	(slime-inferior-process): New connection local variable.
+	(slime-process): Use it.
+	(slime-restart-inferior-lisp): Don't use inferior lisp stuff.
+	(slime-switch-to-output-buffer): Process interactive arguments
+	properly.
+
+	* swank-loader.lisp (compile-files-if-needed-serially): Load
+	verbosely.
+
+2004-10-01  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-allegro.lisp (find-fspec-location): excl:source-file can
+	return stuff like (:operator ...); try to handle it.
+
+	* swank-cmucl.lisp (code-component-entry-points): Only include
+	entry points with "valid" functions names.  This excludes internal
+	lambdas which have usually a string as name, like "defun foo".
+
+	* swank.lisp (parse-symbol): Don't use the reader to avoid
+	interning unknown symbols.  The downside is that we no longer
+	handle escaped |symbols| correctly.
+	
+	* slime.el (slime-set-connection-info): Hide the *inferior-lisp*
+	buffer after we know Lisp's pid.  Print the words of encouragement
+	here, when all the other asynchronous initialization is completed.
+	(slime-find-buffer-package): We need to preserve the case for
+	things like (:in-package "foo"), so return "\"foo\"".
+
+2004-09-27  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-process): New function intended to replace all
+	those references to the *inferior-lisp* buffer.
+	(slime-maybe-start-lisp): Split it up.
+	(slime-start-lisp): New function.
+	(slime-restart-inferior-lisp): Use the command from the existing
+	process to start the new process.
+
+2004-09-27 Christian Lynbech <christian at defun.dk>
+
+	* slime.el (define-slime-dialect): New macro to make starting
+	Lisps with different command line options easier.
+	
+2004-09-27 Rui Patrocínio <rui.patrocinio at netvisao.pt>
+
+	* swank.lisp (mop, mop-helper): Support functions for the class
+	browser.
+
+	* slime.el (slime-browse-classes, slime-browse-xrefs): New
+	commands to browse class hierarchies and xref graphs in a tree
+	widget.
+
+	* tree-widget.el: New file.  Only needed for older Emacsen.
+	
+2004-09-23  Helmut Eller  <heller at common-lisp.net>
+
+	* slime.el (slime-start-and-load): Take arguments so that the
+	function can be called non-interactively. Only start SLIME is if
+	it is not running.
+	(slime-recompile-bytecode): Don't warn about uses of cl-functions.
+	(slime-reset): Kill all sldb buffers.
+	(slime-goto-location-position): Fix syntax for Emacs 20.
+	(sldb-mode-map): Add C-c C-d bindings.
+	(slime-open-inspector): Insert the type in the second line so that
+	we can make longer titles, e.g we should include the princed
+	version of the inspected object.
+
+	* swank-backend.lisp (frame-package, label-value-line)
+	(label-value-line*): New functions.
+
+	* swank.lisp (frame-locals-for-emacs): Bind *print-pretty* to
+	*sldb-pprint-frames* to get more compact lines and bind *package*
+	to frame-package to get shorter labels for variables.
+	(format-values-for-echo-area): Include the hex and octal
+	representation for integers.
+	(apply-macro-expander, disassemble-symbol): Use the buffer-package
+	for reading.
+	(inspector-content-for-emacs): Use print-part-to-string so that we
+	see cycles in the data structure.
+	(inspect-for-emacs): Minor beautifications.
+	(load-file-set-package): New function.
+
+	* swank-cmucl.lisp (frame-package): Implemented.
+	(inspect-for-emacs): Only include stuff that is actually stored in
+	the object itself (see objdef.lisp for exact object layout).
+	Include the disassembly for functions and code components.
+
+2004-09-19  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-gray.lisp (stream-read-char): Treat empty strings as
+	end-of-file.
+
+	* swank-cmucl.lisp (sis/in): Treat empty strings as end-of-file.
+	(map-allocated-code-components): Inhibit efficiency notes.
+	(arglist)[symbol] Delete unreachable code.
+	(sldb-break-on-return, sldb-break-at-start): Implement it
+	(sldb-step): Some cleanups.
+
+	* swank.lisp (thread-for-evaluation): Restart the listener thread
+	if it was dead for some reason.
+	(debugger-condition-for-emacs): Include "extra" stuff. Currenlty
+	only used to pop up the source buffer at breakpoints.
+	(sldb-break): New function.
+	(interrupt-worker-thread): Interrupt the repl thread if there is
+	no other active thread.
+
+	* swank-backend.lisp (import-swank-mop-symbols): New
+	function. Useful if the implementation has most of the mop symbols
+	in the same package.
+	(sldb-break-on-return, sldb-break-at-start, condition-extras): New
+	functions.
+
+	* slime.el (sldb-break-on-return, sldb-break): New commands.
+	(slime-repl-return-string): Allow empty strings.  That's our way
+	to send end-of-file.
+	(sldb-insert-condition): Add "extra" slot for random thing that
+	don't fit nicely somewhere else.
+	(sldb-dispatch-extras): New function.
+	(sldb-show-frame-source): New non-interactive version of
+	sldb-show-source.
+	(sldb-show-source): Use it.
+	(slime-beginning-of-symbol, slime-end-of-symbol): New functions
+	which don't include the character after a hash '#'.
+	(slime-symbol-name-at-point): Use them.
+	(slime-symbol-start-pos, slime-symbol-end-pos): Ditto.
+
+2004-09-17  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp: Don't print "Documentation:" if none is available;
+	add support for classes specializer-direct-methods; deal with
+	eql-specializers in methods.
+	(inspector-princ): New function.
+	(method-specializers-for-inspect): New function.
+	(method-for-inspect-value): New function.
+	(inspect-for-emacs): Use inspector-princ instead of
+	princ-to-string.
+
+	* swank-backend.lisp (swank-mop): Require eql-specializer,
+	eql-specializer-object and specializer-direct-methods in swank-mop
+	package.
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+	swank-openmcl.lisp, swank-sbcl.lisp (swank-mop): Export
+	eql-specializer, eql-specializer-object and
+	specializer-direct-methods from swank-mop.
+
+	* swank-cmucl.lisp (inspect-for-emacs): Thinko fix.
+
+	* swank-lispworks.lisp (swank-mop): Export
+	specializer-direct-methods.
+	(eql-specializer): Implement.
+	(eql-specializer-object): Implement.
+
+	* swank-sbcl.lisp (inspect-for-emacs): Fix broken ignore
+	declaration.
+
+	* doc/slime.texi: Update inspector documentation.
+	
+2004-09-16  Marco Baringer  <mb at bese.it>
+
+	* swank-clisp.lisp (swank-mop, inspect-for-emacs): Only define the
+	CLOS parts of the inspector if the underlying lisp provides the
+	required functionality. If not enough MOP is present to implement
+	the inspector then we define some very simple replacement methods.
+
+2004-09-16  Marco Baringer  <mb at bese.it>
+
+	* swank-clisp.lisp (swank-mop): Implement the MOP compatability
+	package.
+	(inspect-for-emacs): Update for new inspection API.
+
+2004-09-15  Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-openmcl: typo in who-references. Fix frame-var-value
+
+2004-09-15  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-inspector-label-face,
+	slime-inspector-value-face, slime-inspector-action-face,
+	slime-inspector-type-face): These faces now inherit from similar
+	font-lock-<whatever> faces.
+	(slime-open-inspector): Use slime-inspector-value-face for values.
+
+	* swank.lisp (inspect-for-emacs): Add function and compiler-macro
+	documentation when inspecting symbols. View the truename of
+	logical pathnames where they exist. Fix typos in package
+	inspector (fix by Torsten Poulin <torsten at diku.dk>).
+
+	* swank-sbcl.lisp, swank-cmucl.lisp (inspect-for-emacs): Insert
+	function object's documentation when it's available.
+	
+2004-09-15  Eduardo Muñoz  <emufer at terra.es> 
+
+	* .cvsignore: Added *.elc
+
+	* hyperspec.el: Fixed syntax error.
+
+2004-09-15  Alan Caulkins <fatman at maxint.net>
+
+	* swank.lisp (cleanp-connection-threads): Kill all Swank threads
+	for a connection when it terminates.
+
+2004-09-14  Thomas Schilling <tjs_ng at yahoo.de>
+
+	* swank-allegro.lisp (inspect-for-emacs): Fixes to previous patch.
+
+2004-09-14  Marco Baringer  <mb at bese.it>
+
+	* swank-backend.lisp (inspector, make-default-inspector): Add an
+	INSPECTOR object argument to the inspector protocol. This allows
+	implementations to provide more information regarding cretain
+	objects which can't be, or simply aren't, inspected using the
+	generic inspector implementation. also export inspect-for-emacs
+	and related symbols from the backend package.
+	(make-default-inspector): New function.
+	
+	* swank.lisp (inspected-parts): Rename to inspect-for-emacs and
+	add an inspector argument. Move inspect-for-emacs to
+	swank-backend.lisp, leave only the default implementations.
+
+	* swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp,
+	swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename
+	and change argument list. Many of the inspected-parts methods were
+	being clobbered by the inspected-parts in swank.lisp, now that
+	they're being used the return values have been updated for the new
+	inspect-for-emacs API.
+	
+2004-09-14  Thomas Schilling <tjs_ng at yahoo.de>
+
+	* swank-allegro.lisp (inspected-parts): Implement inspector for
+	structs.
+
+2004-09-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (intern-catch-tag): New function.
+	(read-user-input-from-emacs, take-input): Use it.
+
+2004-09-13  John Paul Wallington  <jpw at gnu.org>
+
+	* swank.lisp (define-special): Make the doc-type `variable'
+	rather than `symbol'.  Don't quote `doc'.  Doc fix.
+
+2004-09-09  Martin Simmons <martin at xanalys.com>
+
+	* swank-lispworks.lisp: Set up the swank-mop package.  Implement
+ 	swank-mop:slot-definition-documentation and function-name.
+
+2004-09-13  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (inspected-parts): Added inspectors for pathnames,
+	logical pathnames, standard-objects and numbers (float, ratio,
+	integer and complex).
+
+	* swank-backend.lisp: Define import-to-swank-mop.
+
+	* swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp: Don't
+	define the import-to-swank-mop function (now defined in
+	swank-backend.lisp).
+
+	* swank-cmucl.lisp (swank-mop, function-name): Implement backend
+	for inspector.
+	(arglist): Add support for extracting arglists from function
+	objects.
+	(create-socket): Don't specify the host on PPC.
+
+2004-09-13  Alan Ruttenberg <alanr-l at mumble.net>
+
+        * slime.el slime-goto-location-position: New location specifiers:
+	(:method name specializers . qualifiers) all are strings. Looks
+	for defxxx name then the qualifiers as words, in order then the
+	specializers as words, in order (except for "T", which is
+	optional). Pass the symbols names for specializers and qualifiers 
+	(no packages). Used by openmcl but might be useful for others
+	(:text-anchored <position fixnum> <string> <delta fixnum>) 
+	Got to position, then search for string, then move delta. To
+	support upcoming source recording for openmcl debugging.
+
+	* swank-openmcl multiple changes: - fix support for *sldb-top*
+	 (formerly *swank-debugger-stack-frame*) Was not thread safe. Now
+	 (application-error), and (interrupt-thread) records the error
+	 pointer in a table associated with thread and map-backtrace picks
+	 up the appropriate pointer. *process-to-stack-top*,
+	(grab-stack-top), (record-stack-top).
+
+  	 - Other adjustments for changes to multiprocessing: remove
+	(force-break-in-listener) no longer necessary since we use
+	process-interrupt instead of ccl::*interactive-abort-process*
+	Adjust break-in-sldb to do so for swank repl connections
+	(abstraction breaking reference to swank::*connections*, but
+	nicely via intern)
+
+	 - changes to (find-definitions) (function-source-location),
+	 addition of (maybe-method-location) (remove-filename-quoting).  To support
+	editing definitions of methods. To fix bug with pathnames with
+	quoted characters (like "\\.swank.lisp"). To remove bogus source
+	recording of l1-boot-3 in functions that didn't have a source file
+	noted.
+
+	 - Implementation of xref functions: (xref-locations) uses xref
+	implementation added to openmcl recently. Note that you have to
+	(ccl::start-xref) for it to work for other than who-calls, and
+	that xref information is not currently persisted in fasl files (I
+	will release a patch for this soon) Backend functions (who-binds)
+	(who-macroexpands) (who-references) (who-sets)
+	(who-calls) (list-callees) (who-specializes)
+	
+  	 - Lifted profile backend functions from swank-clisp which use
+	 "metering.lisp"
+
+	 - (openmcl-set-debug-switches) turns on the various variables I.
+	know about that have the lisp record extra debugging
+	information(including starting xref). I suggest you call
+	it. Should it be called by default?
+
+	- (frame-arguments) use builtin ccl::frame-supplied-args since the
+	current version was sometimes missing the first argument to the
+	function. (I think this was when it was passed by register. If you
+	don't want to lose it in the frame locals in backtrace, call
+	(openmcl-set-debug-switches) specifically, set
+	ccl::*ppc2-compiler-register-save-label* to t
+
+	- implement frame-var-value backend
+
+	* metering.lisp: Minor changes to #+ #- to recognize openmcl
+
+	* swank-loader.lisp: Load "metering.lisp"
+		
+2004-09-13  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (inspected-parts): Deal with unfinalized classes in
+	standard-class inspector. (Patch from Thomas Schilling)
+
+2004-09-13  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp: New inspector protocol. The lisp side now returns a
+	specially formated list of "things" to format which are then
+	passed to emacs and rendered in the inspector buffer. Things can
+	be either text, recursivly inspectable values, or functions to
+	call.
+	(inspected-parts): Redefine for new inspector protocol.
+	(*inspectee-parts*): Redefine as array.
+	(*inspectee-actions*): New array, similar to *inspectee-parts*.
+	(reset-inspector): Update for new implementation of
+	*inspectee-parts* and new variable *inspectee-actions*.
+	(inspector-contents-for-emacs): New function.
+	(inspect-object): Update for new inspector protocol.
+	(inspector-nth-part): Update for new *inspectee-parts*
+	implementation.
+	(inspector-call-nth-action): New function.
+
+	* slime.el (slime-inspector-action-face): New face.
+	(slime-open-inspector): Adapt to new inspector protocol.
+	(slime-inspector-operate-on-point): New function, subsumes
+	slime-inspector-inspect-object-at-point.
+	(slime-inspector-next-inspectable-object): Skip to next object,
+	not just end of current object; wrap around buffer.
+	(slime-inspector-mode-map): change bindings of [return] and "\C-m"
+
+	* swank-bacend.lisp (swank-mop): New package. Simply defines all
+	the MOP related symbols we need from an implementation.
+	(arglist): Update doc string. Provide default implementation.
+	(function-name): New backend function.
+	
+	* swank-allegro.lisp (swank-mop, slot-definition-documentation):
+	Implement. (Patch from Thomas Schilling)
+
+	* swank-sbcl.lisp (swank-mop, slot-definition-documentation,
+	function-name): Implement.
+
+	* swank-openmcl.lisp (swank-mop, function-name): Implement.
+	(arglist): Implement for function objects.
+
+2004-09-12  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (compile-file-for-emacs): Use with-buffer-syntax so
+	that SBCL source files can be compiled.  From Christophe Rhodes.
+
+2004-09-09  Martin Simmons <martin at xanalys.com>
+
+	* swank-loader.lisp (make-swank-pathname): Preserve the host
+	component (important for LispWorks on Windows).
+
+2004-09-08  Martin Simmons <martin at xanalys.com>
+
+	* swank-lispworks.lisp: Implement call-with-compilation-hooks.
+
+2004-09-03  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* NEWS: Summarize changes since August.
+
+	* slime.el: Add some docstrings.
+
+	* mkdist.sh: Add PROBLEMS file. We're no longer alpha.
+
+	* swank.lisp: Remove debugging code in comment.
+
+	* swank-sbcl.lisp: Delete dead code.
+
+	* swank-lispworks.lisp (defimplementation): define-dspec-alias
+	seems to more apropriate than define-form-parser.
+
+	* swank-cmucl.lisp (print-frame): Catch errors during printing.
+
+	* README: Fix typo.
+
+2004-09-02  Wolfgang Mederle <wolfgang.mederle at stud.uni-muenchen.de>
+
+	* swank-loader.lisp (*lisp-name*): Replace / with - in CMUCL
+	version strings.
+
+2004-09-01  John Paul Wallington  <jpw at gnu.org>
+
+	* slime.el (slime-oneliner): Don't use free variable.
+	(slime-recenter-window, slime-set-connection-info)
+	(slime-pprint-event, slime-compiler-notes-quit)
+	(slime-apropos-summary): Likewise.
+	(slime-connect): Tidy up handshake `message' call.
+
+2004-09-01  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-push-directory): Fix interactive spec.
+	(sldb-reference-properties): Take a the reference object as
+	argument instead of its parts. Fix callers accordingly.
+	(slime-fuzzy-choices-buffer): Remove assignment to unused variable
+	slime-fuzzy-target-mtime.
+	(slime-ed): Replace call to new-frame with make-frame.
+	(sldb-find-buffer): Cleanup.
+	(sldb-highlight-sexp): Fix regexp. It's now almost a full line.
+
+	* swank.lisp (completion-set, tokenize-symbol-designator)
+	(tokenize-completion, fuzzy-completion-set)
+	(briefly-describe-symbol-for-emacs): Remove simple-base-string
+	declarations.
+
+2004-08-30  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* PROBLEMS: We require SBCL 0.8.13.  0.8.12 is no longer
+	supported.
+
+	* swank-allegro.lisp (find-fspec-location): Catch errors in
+	excl:source-file.
+
+	* swank.lisp (send-to-socket-io): Add some ignore declarations.
+
+	* slime.el (sldb-fetch-all-frames, sldb-end-of-backtrace)
+	(sldb-beginning-of-backtrace): New commands.
+	(slime-search-suppressed-forms): Change the start regexp so that
+	reader conditionals in single line comments, like "; #+foo", are
+	ignored.
+
+2004-08-27  Peter Seibel  <peter at javamonkey.com>
+
+	* swank-backend.lisp (swank-compile-string): Add directory
+	argument which is used by Allegro backend to improve source
+	recording for definitions compiled with C-c C-c.
+ 
+2004-08-23  John Paul Wallington  <jpw at gnu.org>
+
+	* slime.el (slime-pretty-package-name): Fix last cond clause.
+
+2004-08-21  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (*global-debugger*): New configurable to globally
+	install swank-debugger-hook as *debugger-hook*. True by default.
+
+2004-08-19  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi: C-c C-c C-a, C-c C-u C-e.
+	Thanks Barry Fishman for reporting incorrect indexing.
+
+2004-08-18  Matthew Danish <mrd+nospam at cmu.edu>
+
+	* swank-allegro.lisp (swank-compile-string): Use #\; instead of
+	#\: to separate the position from the buffer-name.  This avoids
+	troubles on Windows.
+
+2004-08-16  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi: Random updates.
+
+	* slime.el (slime-space): Use slime-message instead of
+	slime-background-message. This displays multi-line arglists.
+	(sldb-mode-map): Bind 'C' to sldb-inspect-condition.
+
+2004-08-14  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-find-buffer-package): Use "%s", not "%S", to
+	avoid ugly escape characters, if the package name contains dots.
+
+2004-08-13  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-eval-in-frame): Print result to the REPL when a
+	prefix argument is given.
+	Added pull-down menus for SLDB and the REPL.
+
+	* swank-source-path-parser.lisp: Removed caching of readtables and
+	the source-map hashtable. Fresh creation is ultra-cheap (<1ms).
+	The caching didn't handle modifications to readtables and
+	generally made me feel uneasy while tracking down an obscure bug
+	in a reader macro.
+	The cached source-map hashtable also wasn't thread-safe (ho hum).
+
+2004-08-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-merge-notes, slime-tree-for-note): Use the short
+	note message for annotation in the source buffer and the long
+	message in the tree widget.  Used to be the other way around.
+	(sldb-insert-frames): Set the `start-open' property for XEmacs.
+	Without `start-open', the `point-entered' property is inherited
+	when we insert something before the "--more--" marker.  Reported
+	by Sundar Narasimhan.
+
+	* swank.lisp (variable-desc-for-echo-area): Bind some printer
+	variables to limit the length of the output.
+
+2004-08-05  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-setup): Added typeout-frame keyword argument.
+	(slime-thread-attach): Fixed misnamed function call.
+
+2004-08-04  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-allegro.lisp (find-fspec-location): Fixed to work for more
+	types of definition than just functions. So M-. now works for e.g.
+	classes in Allegro. From Matthew Danish.
+	(find-fspec-location): Include the type of the definition in the
+	designator sent to Emacs. From Matthew Danish.
+
+2004-08-04  Martin Simmons <martin at xanalys.com>
+
+	* swank-lispworks.lisp (frame-actual-args): Correct syntax for
+	handler-case.
+
+2004-08-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: (slime-mode-map, slime-repl-mode-map)
+	(slime-repl-read-mode-map): Remove the binding for C-c C-g.  C-c
+	C-b is now the default interrupt key.
+	(slime-list-repl-short-cuts): Don't trash the shortcut-table: copy
+	it before sorting.  (Thanks to Mark Simpson.)
+
+2004-08-02  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-connect): Shorten the welcome message by leaving
+	out the port number (which is displayed in the REPL anyway). This
+	avoids line-wrapping some messages of encouragement.
+
+	* swank.lisp (with-buffer-syntax): Don't bind *readtable* to
+	*buffer-readtable* if they are already EQ. When we shadow this
+	binding the user can't assign *readtable* from the REPL so it's
+	best avoided when possible.
+
+	* swank-allegro.lisp: Removed fwrapper-based code for inheriting
+	"swankiness" to newly spawned threads. This was fighting the
+	system and not the right thing.
+
+	* slime.el (slime-choose-overlay-region): Tweaked the
+	multiline-annotation-avoidance code to work with forms not
+	starting with an open-paren, e.g. `(..) or #'(..).
+	(slime-update-modeline-package): New configurable. Non-nil (the
+	default) means update the Lisp package in the modeline using an
+	idle timer.
+	(slime-repl-send-input): Make the `slime-repl-old-input' property
+	cover the whole input (including newline) so that pressing RET on
+	the end of an input line works.
+	Use a unique integer as the value of this property to distinguish
+	adjacent inputs.
+	(slime-current-package): Deal with narrowing.
+
+2004-08-01  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp (swank-compile-string): Use a temporary file
+	and set excl::*source-pathname* manually.  This way we can find
+	the source buffer of functions compiled with C-c C-c.
+	(call-with-temp-file, compile-from-temp-file): New functions.
+	(list-callers, function-callers, in-constants-p)
+	(map-function-constants): Implements list callers by groveling
+	through the constants pools of named functions.
+
+	* swank-lispworks.lisp: Minor refactoring.
+
+2004-07-30  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-connection): Say "No default connection
+	selected" if there are open connections but no default connection.
+	(slime-tree-indent-item): Point wasn't updated correctly if the
+	last line was empty.  Use insert-before-markers instead of insert
+	to do it properly.
+	(slime-draw-connection-list): Don't break if there is no default
+	connection.
+
+	* swank-cmucl.lisp (call-with-debugging-environment): Only handle
+	DI::UNHANDLED-CONDITION not all DI:DEBUG-CONDITIONs.
+
+	* swank-backend.lisp (sldb-condition): Show the original condition
+	in the message.
+
+2004-07-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-eval-feature-conditional): Treat uppercase
+	operators NOT, AND, OR correctly.
+	(sldb-find-buffer): Remove killed buffers.
+	(sldb-quit): Raise an error if the RPC returns.
+	(slime-expected-failures): Delete unused function.
+	(complete-symbol): Test completion of
+	swank::compile-file. LispWorks has extra completions for
+	cl::compile-file.
+	(arglist): Test arglist of method cl:class-name.  Add enough
+	regexpery to pass the test in most implementations.
+
+	* swank-sbcl.lisp (list-callers, list-callees): Implemented.
+
+2004-07-26  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-first-change-hook): Add `save-match-data' to
+	avoid breaking e.g. query-replace. Also added `save-excursion'
+	just to be safe.
+
+	* README: s/setup-slime/slime-setup/ in the .emacs snippet.
+
+2004-07-23  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-set-state): Show the message in the modeline in
+	the case where we aren't connected. Otherwise the "not connected"
+	status is ignored.
+	(slime-net-sentinel): Close the connection before changing the
+	status message. The old behaviour of this combined with the old
+	behaviour of `slime-set-state' could generally cause spurious
+	errors after a connection was closed.
+
+2004-07-22  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (carefully-find-package): Return *BUFFER-PACKAGE* if
+	no other package can be found. This is reverting a previous change
+	that broke completion in buffers with no known package.
+
+	* slime.el (slime-maybe-start-lisp): Check that *inferior-lisp*
+	exists /and/ has a running process. Fixes a startup problem if
+	your inferior-lisp has died and you want to restart SLIME.
+
+2004-07-21  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-sync-package-and-default-directory): Sync
+	`default-directory' in the REPL buffer too.
+	(slime-set-state): Convenience function for setting a connection's
+	state-name and updating the modeline if appropriate. This function
+	is called in the right places.
+	(slime-to-lisp-filename): Use `expand-file-name'.
+
+2004-07-20  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-repl-update-banner): Restore old behaviour of
+	using an asynchronous evaluation to setup the REPL. This works
+	around a problem I'd reintroduced where the first REPL command
+	uses the wrong keymap.
+
+2004-07-20  Andreas Fuchs  <asf at boinkor.net>
+
+	* swank-sbcl.lisp (call-with-compilation-hooks): Trap and report
+	errors that cause compilation to fail, e.g. read errors.
+
+2004-07-19  Luke Gorrie  <luke at bluetail.com>
+
+	* HACKING: Updated. Some notes about Emacs features.
+
+	* slime.el: More major refactoring.
+	Restructured and documented the networking and protocol code.
+	(slime-rex-continuations): Now connection-local.
+
+2004-07-18  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Major refactoring.
+	Mostly resectioning and reordering definitions to try and improve
+	readability.
+	(slime-get-temp-buffer-create): New utility function to popup a
+	temporary buffer that automatically has a binding on `q' to
+	intelligently restore window configuration. Handy, but currently
+	not applicable to all of our temporary buffers.
+	(slime-with-chosen-connection): Removed this macro. Consequently
+	the compilation commands no longer prompt for which connection to
+	use when given a prefix argument. `slime-switch-to-output-buffer'
+	still works like that, but for other cases I think the
+	connection-list buffer is sufficient.
+	(slime-eval-async): New arglist: (form &optional cont pkg). If the
+	continuation is unspecified then the evaluation result is ignored,
+	and if the package is unspecified then (slime-buffer-package) is
+	used.
+	(slime-eval): Package arg now defaults to (slime-buffer-package).
+	(slime-current-package): New name for (slime-buffer-package). No
+	more caching: returns the buffer-local `slime-buffer-package' if
+	set, otherwise searches for an `in-package' form.
+	A consequence of non-caching is that the package name doesn't
+	appear in the modeline anymore. The simplification is worthwhile
+	in my opinion.
+
+2004-07-17  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-autodoc): If there is a global variable name at
+	point then show its value.
+	(slime-autodoc-cache-type): Cache type 'full is no longer
+	supported.
+	(slime-background-message): Truncate messages to fit on a single
+	echo area line.
+	(slime-repl-update-banner-p, slime-dont-prompt)
+	(slime-swank-connection-retries): Removed these unused or unuseful
+	configuration variables.
+	Rearranged organised "customize" groups.
+
+	* swank.lisp (variable-desc-for-echo-area): New function.
+	(arglist-for-echo-area): Return nil if symbol can't be found.
+	(close-connection): Close connection before printing error
+	message. This avoids it getting lost in closed I/O redirection.
+
+	* README, doc/slime.texi: Updated setup instructions.
+
+2004-07-16  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-conservative-indentation): New variable. When
+	true (the default) don't auto-learn indentation of def* and with-*
+	macros. Set to nil if you want to learn them.
+	(slime-handle-indentation-update): Use it.
+
+	* swank.lisp (known-to-emacs-p): Removed filtering of def* and
+	with-*. Now handled by Emacs.
+
+	* slime.el (slime-interactive-eval): Changed display of results.
+	By default the result goes to `slime-message', which leads either
+	to echo area, temporary buffer, or typeout frame.
+	With a prefix argument the result is printed to the REPL.
+	This goes for all commands based on slime-interactive-eval, e.g.
+	`C-x C-e' and `C-c M-:'.
+
+2004-07-16  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el (package-updating): Fixing this and other tests I broke
+	with my change to how emacs keeps track of the package prompt
+	string.
+	(arglist): Fix an test failure under Allegro due to a slight
+	difference in the way EXCL:ARGLIST returns arglist (no default
+	values of &optional parameters)
+
+2004-07-16  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (print-connection): print-function for connection
+	objects. Dumping the indentation-cache was damned ugly with
+	non-truncated lines (e.g. bug reports on slime-devel).
+
+	* slime.el (slime-setup): New function for installing a
+	lisp-mode-hook. You can call this from ~/.emacs to setup SLIME.
+	Takes a `autodoc' keyword argument to enable
+	slime-autodoc-mode. We can add more keywords in future.
+	(slime-keys): Moved `slime-reindent-defun' from C-M-q to
+	C-cM-q. This avoids overriding the standard binding of C-M-q to
+	index-sexp.
+	(slime-typeout-frame-properties): Removed some properties:
+	`name', because it interacts badly with X properties, `left' and
+	`top' because they don't put the frame anywhere terribly
+	convenient, and (width . 40) because it makes the frame narrower
+	than the usual word-wrapping width.
+
+2004-07-14  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el (slime-lisp-package-prompt-string): Separate SLIME's
+	notion of package into two parts, an actual package name and the
+	name used in the prompt since the latter isn't necessarily an
+	actual package nickname any more.
+
+2004-07-13  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-restart-inferior-lisp): Renamed shortcut to
+	"restart-inferior-lisp" from "restart-lisp". The name better
+	suggests what it does: kill *inferior-lisp* and rerun SLIME.
+
+2004-07-13  Eric Blood  <eblood at winkywooster.org>
+
+	(slime-inspector-next-inspectable-object): New inspector command
+	to goto the next inspectable object (slot). Bound to TAB.
+
+2004-07-13  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* slime.el: add support for actionable references in the
+	*slime-compiler-notes* buffer.
+	(slime-merge-notes): merge references if applicable.
+	(slime-compiler-notes-mode-map): use new functions defaulting to
+	show-details, but overrideable by text properties.
+	(slime-tree-default-printer): destroy generality by assuming a
+	tree of conditions, and insert references if applicable.
+	(sldb-format-reference-source): add :amop
+	
+	* swank-sbcl.lisp (signal-compiler-condition,
+	brief-compiler-message-for-emacs,
+	long-compiler-message-for-emacs): handle references in compiler
+	conditions.
+
+	* swank.lisp (make-compiler-note): propagate references.
+
+	* swank-backend.lisp (compiler-condition): add references slot.
+	
+2004-07-12  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-easy-menu): Added "Apropos all" menu item.
+	(slime-restart-lisp): Added `restart-lisp' shortcut. Doesn't do
+	the right thing if you have multiple Lisps up.
+
+	* swank.lisp: Added some docstrings.
+	Rearranged completion code and somewhat SLDB trying to layout
+	functions above their subfunctions in a tree-like way.
+	(slime-protocol-error): Renamed from slime-read-error.
+	(carefully-find-package): Now returns NIL if package can't be
+	determined, rather than *BUFFER-PACKAGE*. Correct? I didn't see
+	why it should return *BUFFER-PACKAGE*.
+	(xref): Find symbol in *BUFFER-PACKAGE*.
+
+2004-07-09  Peter Seibel  <peter at javamonkey.com>
+
+	* swank.lisp (package-string-for-prompt): Change the way package
+	name in prompt is computed. N.B. after this change the name
+	displayed will not necsarily be either an actual name or nickname
+	of the package: if the name contains dots by default the prompt
+	will only display the last element, i.e. COM.GIGAMONKEYS.SPAM will
+	be shown as SPAM. This change also makes CL-USER the canonical
+	name for COMMON-LISP-USER even in implementations that provide a
+	shorter nickname such as USER.
+
+2004-07-09  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* slime.el (sldb-lookup-reference): substitute hyphens for spaces
+	in the url.
+
+2004-07-07  Thomas Schilling  <tjs_ng at yahoo.de>
+
+	* swank.lisp (arglist-for-insertion): Changed formatting to use
+	arglist-to-string. That results in proper cases for
+	slime-insert-arglist.
+
+2004-07-07  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-loader.lisp (*lisp-name*): Include the version number in
+	ACL.
+
+	* slime.el (slime-alistify): Preserve order. This keeps the
+	*compiler-notes* right. Pointed out by Christophe Rhodes.
+	(slime-repl-update-banner-p): Renamed from slime-reply-..
+	(slime-changelog-date): Reintroduced for informational purposes.
+	(slime-repl-update-banner): Show ChangeLog date in the animation.
+	(slime-space): Do arglist lookup before inserting the
+	space. Otherwise we get a funky race condition: entering the space
+	may trigger `first-change-hook', which would send an async
+	notification to Lisp, which would put us in the 'busy' state and
+	thus we wouldn't lookup the arglist! Detective work by Edi Weitz.
+	(sldb-prune-initial-frames): More regexp fudgery :-(.
+	(read-directory-name): Use `file-name-as-directory' to ensure we
+	have the trailing / on the directory name.
+	(byte-compile-warnings): Bye-compile slime-alistify. Its inputs
+	can be pretty big.
+
+2004-07-04  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el, swank-backend.lisp, swank.lisp: Added a new backend
+	function `buffer-first-change' which is called via Emacs's
+	`first-change-hook' in slime-mode buffers. This gives Lisp a
+	chance to do something with source files before you change them on
+	disk.
+
+	* swank-cmucl.lisp (buffer-first-change): Suck the source file
+	into the cache unless already present. This is for M-. to increase
+	the chances of our having a copy of the sources corresponding with
+	the loaded code. Should help with the case where a user edits and
+	saves a file (without recompiling it) and then M-.'s for one of
+	its definitions.
+
+	* swank-allegro.lisp (make-process/inherit): Changed reader
+	conditionals to use fwrappers for #+(version>= 6).
+
+	* swank-backend.lisp (make-stream-interactive): This backend
+	function is called with each stream that will be used for
+	user-interaction, i.e. the redirected stdio streams. Can be used
+	to setup special output-flushing or similar.
+
+	* swank.lisp (open-streams): Call make-stream-interactive on the
+	redirected io streams.
+
+	* swank-allegro.lisp (make-stream-interactive): Set
+	interactive-stream-p slot on the stream to make it auto-flush.
+	(*swank-thread*, *inherited-bindings*): New variables.
+	(spawn): Bind *swank-thread* to T.
+	(make-process/inherit): Fwrapper (advice) for
+	mp:make-process. When *swank-thread* is T then make the new thread
+	inherit "sliminess": debugger hook, I/O streams, and also
+	*swank-thread* so that its children will inherit too.
+
+2004-07-03  Luke Gorrie  <luke at bluetail.com>
+
+	* hyperspec.el (common-lisp-hyperspec-section-4.0): Bugfix from
+	Lennart Staflin.
+
+	* slime.el (slime-repl-clear-output): Avoid clearing the previous
+	REPL expression too. Patch from Andras Simon.
+
+	* swank-backend.lisp (definterface): Don't use
+	NO-APPLICABLE-METHOD for default methods. Instead just define them
+	as regular methods with all argument types being
+	T. Defimplementation will then replace them by using the same
+	signature. N-A-M was a stupid idea!
+
+2004-07-02  Brian Downing  <bdowning at lavos.net>
+
+	* slime.el (slime-reindent-defun): Added a check for (boundp
+	'slime-repl-input-start-mark) before checking the variable, as
+	XEmacs leaves variables unbound when `make-variable-buffer-local'
+	is run, while GNU Emacs binds them to NIL.
+
+2004-07-02  Martin Simmons <martin at xanalys.com>
+
+	* swank-lispworks.lisp (dspec-stream-position,
+	make-dspec-location): Fix typo in features for LW 4.1 and 4.2.
+
+2004-07-01  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (frame-actual-args): Bind
+	*break-on-signals* to nil and special case &rest, &optional, and
+	&key.
+
+2004-07-01  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-lookup-reference): Preserve case in SBCL node
+	names. Previously they were downcased, but the HTML manual's
+	filenames seem to have changed.
+
+	* NEWS: Added security note about the TCP server.
+	Added notes for ACL and ABCL.
+
+	* doc/slime.texi: General updatings for an alpha release.
+
+2004-06-30  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-display-compilation-output): New customizable
+	variable.
+
+	* swank.lisp: Minor cleanups.
+	(find-symbol-designator, find-symbol-or-lose)
+	(case-convert-input): Deleted.  Replaced with calls to
+	parse-symbol{-or-lose}.
+
+	* swank-lispworks.lisp (describe-symbol-for-emacs): Include
+	information about setf-functions.
+	(emacs-connected): Add a default method to
+	env-internals:environment-display-debugger.
+
+2004-06-30  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-read-port-and-connect-to-running-swank)
+	(slime-connect, slime-open-stream-to-lisp): Replace "localhost"
+	with "127.0.0.1". This is believed to avoid unwanted DNS lookups
+	on certain operating systems. The lookups can become crippling if
+	the DNS server isn't available.
+	(line-beginning-position, line-end-position): Simple bugfix
+	suggested by Richard Klinda.
+
+	* swank-sbcl.lisp (preferred-communication-style): Choose
+	:fd-handler instead of :sigio when threads aren't available. A lot
+	of people seem to have had problems with :sigio on SBCL.
+
+2004-06-30  Luke Gorrie  <luke at bluetail.com>
+
+	* NEWS: Wrote preliminary release notes for alpha-1.
+
+2004-06-29  Luke Gorrie  <luke at bluetail.com>
+
+	* mkdist.sh: New shell script for creating a tarball for
+	distribution.
+
+2004-06-29  Bill Clementson  <Bill_Clementson at peoplesoft.com>
+
+	* slime.el (slime-who-map): Add extra bindings for the XREF
+	commands as with the documentation commands. Now `C-c C-w C-c' is
+	`slime-who-calls' in addition to `C-c C-w c', etc.
+
+2004-06-29  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-prune-initial-frames): Tweaked regexp for
+	matching SWANK's own stack frames for effectiveness in SBCL.
+	(slime-keys): Shadow remaining inf-lisp keys (C-c C-a, C-c C-v)
+	with a null `slime-nop' command until we put them to a real use.
+
+	* swank.lisp (open-streams): Renamed the restart around reads from
+	the user-input stream from ABORT to ABORT-READ. Invoking this
+	restart seems kinda dangerous, so better for 'a' in SLDB not to do
+	so.
+
+2004-06-28  Thomas F. Burdick  <tfb at OCF.Berkeley.EDU>
+
+	* swank.lisp (inspector-nth-part):
+	* slime.el (slime-inspector-copy-down, slime-inspector-mode-map):
+	Added copy-down command (M-RET) to easily move an object from the
+	inspector to the repl.
+
+2004-06-28  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-doc-map): New keymap for documentation
+	commands. These all use the `C-c C-d' prefix, followed by:
+	  a - apropos
+	  p - apropos-package
+	  z - apropos-all
+	  d - describe-symbol
+	  f - describe-function
+	  h - hyperspec lookup
+	  ~ - hyperspec lookup of a format character
+	The final keystroke is bound both unmodified and with control, so
+	both `C-c C-d a' and `C-c C-d C-a' will make an apropos
+	search. The exception is hyperspec-lookup, because it's nice to
+	leave C-h unbound so that `C-c C-d C-h' will summarise the
+	documentation bindings.
+
+2004-06-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp (nth-frame): Skip frames where
+	frame-visible-p is false.
+
+	* slime.el (slime-buffer-package): Return the cached package if we
+	can't find something more sensible; this reverts a previous
+	change.  The Lisp side will now fall back to an existing package
+	if the one supplied by Emacs doesn't exist.  Using the cached
+	version is also necessary for some commands in the apropos buffer.
+	(sldb-insert-frame): Set the default-action property; pressing RET
+	on frame lines now shows/hides details.
+	(sldb-toggle-details): Preserve the current column.
+	(slime-inspector-buffer, slime-saved-window-config)
+	(slime-inspector-quit): Save and restore the window configuration.
+	(slime-highlight-suppressed-forms, slime-search-suppressed-forms):
+	Display expressions with reader conditionals (#+/#-) in
+	font-lock-comment-face if the test is false.  Not implemented for
+	XEmacs.
+	(repl-return): New test.
+
+2004-06-28  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Events in the *slime-events* buffer are now exact
+	on-the-wire messages, without including e.g. Elisp continuation
+	functions. This is easier for debugging I think.
+
+	* swank-allegro.lisp (compute-backtrace): Only include frames
+	satisfying `debugger:frame-visible-p'. I did this as a lame
+	workaround for a problem where `output-frame' was segfaulting on
+	certain frames, and those frames happened not to be visible-p. I
+	don't know if it really fixes anything.
+
+	* hyperspec.el (common-lisp-hyperspec-format): This command now
+	works at the end of the buffer, fixed `char-after' usage as
+	suggested by Johan Bockgård.
+
+2004-06-28  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* hyperspec.el: add support for issue cross-reference lookups,
+	strongly inspired by hyperspec symbol lookup.
+	(common-lisp-hyperspec-issuex-table,
+	common-lisp-hyperspec-issuex-symbols): new variables
+	(common-lisp-issuex): new function
+
+	* slime.el (sldb-format-reference-node, sldb-lookup-reference):
+	(sldb-reference-properties): use new support for issue lookups
+	to support :ansi-cl :issue reference types.
+
+	* hyperspec.el: add support for glossary lookups.
+	(common-lisp-glossary-fun): new variable
+	(common-lisp-glossary-4.0, common-lisp-glossary-6.0): new functions
+	
+	* slime.el (sldb-format-reference-node, sldb-lookup-reference):
+	(sldb-reference-properties): use new support for glossary lookupts
+	to support :ansi-cl :glossary reference types.
+
+2004-06-27  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* doc/slime.texi: Remove macros from chapter and section headings
+	to avoid texi2pdf breakage.
+
+	* swank-source-path-parser.lisp (cmucl-style-get-macro-character):
+	Add tests for #\space and #\\.  Suggested by Christophe Rhodes.
+
+	* swank-sbcl.lisp, swank-openmcl.lisp, swank-lispworks.lisp,
+	swank-cmucl.lisp, swank-backend.lisp, swank-allegro.lisp,
+	swank-abcl.lisp (thread-id, find-thread): New backend functions.
+
+	* swank.lisp (dispatch-event): Quitting from the debugger was
+	seriously broken.  Fix it.  Move generation of thread ids to the
+	backends.
+	(encode-message, send-to-socket-io): Use WITHOUT-INTERRUPTS in
+	send-to-socket-io.  The multithreaded version of encode-message
+	doesn't need it.
+	(nth-thread): Renamed from lookup-thread-by-id.
+	(debug-nth-thread): Renamed from debug-thread-by-id:
+	(kill-nth-thread): Renamed from kill-thread-by-id.
+
+	* slime.el (sldb-get-buffer): Add support for sldb buffers for
+	multiple threads.
+
+2004-06-25  Thomas F. Burdick  <tfb at OCF.Berkeley.EDU>
+
+	* swank-sbcl.lisp (call-with-syntax-hooks, with-debootstrapping):
+	Preserve compatability with fairly recent SBCLs by checking for
+	the presense of the debootstrapping facilities at macroexpansion
+	time.
+
+	* slime.el (sldb-insert-condition): Initialize sldb-default-action
+	so that pressing RET inspects the condition.
+	
+2004-06-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-insert-prompt): Set defun-prompt-regexp.
+	beginning-of-defun can be very slow in the repl buffer if the
+	defun-prompt-regexp is not set.
+	(sldb-insert-locals): Initialize sldb-default-action.
+	(sldb-var-number-at-point, sldb-inspect-var): New function.
+
+	* swank.lisp (inspect-frame-var): New function.
+
+	* swank-backend, swank-cmucl.lisp, swank-sbcl.lisp,
+	swank-allegro.lisp, swank-lispworks.lisp, swank-clisp.lisp
+	(frame-var-value): New backend function.
+
+2004-06-24  Christophe Rhodes  <csr21 at cam.ac.uk>
+
+	* slime.el (sldb-format-reference-node): fix for when `what' is a
+	list.
+	(sldb-lookup-reference,sldb-reference-properties): support
+	:ansi-cl :section reference types.
+
+	* hyperspec.el (common-lisp-hyperspec-6.0): generalize to work
+	with section numbers lower than 10.
+
+2004-06-24  Brian Downing  <bdowning at lavos.net>
+
+	* slime.el (slime-repl-send-input): Fixed a subtle difference in
+	sending input to the Lisp introduced in 1.316.  The newline was
+	not getting sent, resulting in the Lisp constantly asking for more
+	read data.  I believe the code has been adjusted to behave the
+	same as 1.315 with regard to sending newlines.
+	Also adjusted the `slime-repl-old-input' text property to end just
+	before the newline, not just after.  This causes a gap between
+	inputs even if no Lisp output appeared in between, so that putting
+	point on an old line and hitting RET will only call up that line,
+	and hitting RET in the middle of the current line will send it and
+	not bring up a confusing combination of all previous input.
+	Many thanks to Loyd Fueston for pinpointing the date and exact
+	patch for when this problem was introduced.
+
+2004-06-23  Brian Downing  <bdowning at lavos.net>
+
+	* slime.el: Re-added most of Luke's patches from yesterday.  It
+	has the shortened names, uses markers instead of stored `(point)'
+	values, and `slime-fuzzy-complete-symbol' is an option for
+	`slime-complete-symbol-function'.
+	It still string compares the target buffer instead of using
+	`(buffer-modified-tick)'.
+	I left the `C-c M-i' keybinding in, as it allows use of the
+	regular completion as well.  If there's an objection to this it
+	can be removed.
+	`window-configuration-change-hook' is used if the variable is
+	present, and ignored it not.  This neatly sidesteps its absence in
+	XEmacs while not killing the functionality for GNU Emacs.
+
+	* doc/slime.texi: Added a command entry and short description for
+	`C-c M-I, slime-fuzzy-complete-symbol', and added its existence to
+	the `slime-complete-symbol-function' documentation.
+	
+2004-06-22  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi: Noted ABCL support.
+
+	* slime.el: Backed out all of my changes to fuzzy completion. I
+	was too hasty and didn't do good things. Now it's back in pristine
+	state from Brian's patch -- use `C-c M-i' to fuzzy-complete.
+
+	* doc/Makefile (contributors.texi): The contributors list in the
+	manual is now sorted by most number of ChangeLog entries. Patch
+	from Michael Weber.
+
+	* slime.el: Some minor hacking to fuzzy completion:
+	Use the shorter `slime-fuzzy-' symbol prefix.
+	Use markers instead of numbers to remember where the completion is
+	being done. This way they are self-updating.
+	Use `buffer-modified-tick' to detect modifications instead of text
+	comparison.
+	Always restore window configuration when a completion is
+	chosen. For this completion style I think this will work okay
+	[famous last words], and the existing code wasn't
+	XEmacs-compatible for want of window-configuration-change-hook.
+	Now there is no separate keybinding for fuzzy completion, but it's
+	included as a customize option for `slime-complete-symbol-function'
+	
+2004-06-22  Brian Downing  <bdowning at lavos.net>
+
+	* slime.el, swank.lisp: Added "fuzzy completion."
+
+2004-06-22  Matthew Danish  <mdanish at andrew.cmu.edu>
+
+	* swank-backend.lisp (unbound-slot-filler): New structure for
+	representing an unbound slot in the inspector functions.
+
+	* swank.lisp, swank-allegro.lisp: Use it.
+
+2004-06-22  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-output-filter): Choose connection based on
+	process-buffer, not current buffer. This fixes a bug where output
+	from multiple Lisp sessions could get mixed up.
+	(slime-kill-all-buffers): Include all *inferior-lisp*[<n>] buffers.
+	Split the customize settings into more subgroups.
+
+	* swank.lisp (prefixed-var): Intern *REAL-STANDARD-INPUT* etc in
+	the SWANK package instead of the COMMON-LISP package.
+
+2004-06-21  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-loader.lisp (*lisp-name*): Add version number to
+	Lispwork's fasl directory. We should do this for ACL and OpenMCL
+	too, but for some reason my ACL 5.0 gets an error when trying to
+	create a directory with a version number in its name, and I don't
+	have OpenMCL to test with.
+
+	* swank-backend.lisp, swank.lisp (add-hook, run-hook): Moved the
+	hook mechanism and all hooks to swank.lisp (from
+	swank-backend.lisp). There is no compelling use for the hooks in
+	backends yet and I want to pass swank.lisp-internal data
+	structures in the existing hooks.
+	(notify-backend-of-connection): Call `emacs-connected' with the
+	user-io stream for its argument. Should fix previous breakage
+	where the connection structure was passed instead.
+	(*globally-redirect-io*): New configurable: when true the standard
+	streams are globally redirected to Emacs. That way even
+	e.g. SERVE-EVENT handlers will print to Emacs. Currently does not
+	handle standard input -- that is trickier since the Lisp's native
+	REPL can be trying to read from that.
+
+	* slime.el (slime-complete-maybe-restore-window-configuration):
+	Only restore the window configuration if the completions buffer is
+	currently visible in the window that we popped it up in.
+	(slime-complete-maybe-save-window-configuration): Don't save the
+	window configuration if the completions buffer is already visible.
+	(slime-repl-return): Make sure the newline goes at the end of the
+	input, not at point.
+	(slime-complete-restore-window-configuration): Wrap the
+	`set-window-configuration' call in (run-at-time 0 ..). XEmacs does
+	not allow us to set the window configuration from inside
+	pre-command-hook.
+
+2004-06-20  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-sbcl.lisp (emacs-connected): Set *invoke-debugger-hook* to
+	our debugger hook.  Not optimal, but at least BREAK will then
+	invoke our debugger.
+	(*trap-load-time-warnings*): New variable.  If it is true,
+	conditions, most notably redefinition warnings, signalled at load
+	time are not trapped.
+	(swank-compile-file, swank-compile-string): Use it.
+	
+	* swank.lisp (guess-buffer-package): Don't signal a continuable
+	error if the package doesn't exists; that's too annoying.
+
+	* slime.el: Fix outline structure.
+        (slime-maybe-list-compiler-notes): Fix thinko.
+	(break): New test.  Reorganize the test-suite a bit to support
+	"expected failures".
+	(slime-eval-feature-conditional, slime-to-feature-keyword): Add a
+	?: to the symbol-name if needed.
+	
+2004-06-20  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (changelog-date): Removed unneeded function.
+	(connection-info): No more version field in result.
+
+	* slime.el: Audited to remove namespace slipups. Tracking a really
+	horrible clashing-with-some-user-configuration bug and want to
+	eliminate potential symbol conflicts.
+	(sldb-get-buffer): Renamed from `get-sldb-buffer'.
+	(slime-emacs-20-p): Renamed from `emacs-20-p'.
+	(slime-defun-if-undefined): Renamed from `defun-if-undefined'.
+	(slime-isearch): Small bugfix that could cause M-. to go to the
+	wrong place in CMUCL.
+	(slime-changelog-date, slime-check-protocol-version): Removed
+	unneeded functions.
+
+	* swank-backend.lisp (add-hook, run-hook): Added an Emacs-like
+	hook mechanism.  The hope is that this will make some sections of
+	the code more self-describing by showing where they hook in.
+	(*new-connection-hook*): Hook run when a new connection is
+	established. Initialized to '(swank-backend:emacs-connected).
+	(*pre-reply-hook*): Hook run before sending a reply to Emacs.
+
+	* swank.lisp: Added some comments and docstrings.
+	(package-external-symbols): Removed unused function.
+	(serve-connection): Call *new-connection-hook*.
+	(eval-for-emacs): Call *pre-reply-hook*.
+	(sync-features-to-emacs, sync-indentation-to-emacs): Added to
+	*pre-reply-hook*.
+	(cl-package, keyword-package): Now defconstant instead of
+	defvar. Removed the *'s accordingly.
+
+	* slime.el (slime-abort-connection): Renamed from
+	`slime-connection-abort'. The new name is easier to find with
+	completion.
+
+	* swank-sbcl.lisp: Change sb-posix:: to sb-posix:
+
+2004-06-19  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (known-to-emacs-p): Bugfix. Indentation-updates was
+	broken.
+
+2004-06-18  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-buffer-package): If DONT-CACHE is true and no
+	package name can be found, then default to "COMMON-LISP-USER."
+	Previously we just kept using the cached version, but that could
+	lead to error-after-error if it was incorrect.
+
+	* swank.lisp (throw-to-toplevel): If our top-level catcher isn't
+	on the stack (i.e. we're using the debugger from outside an RPC)
+	then ABORT instead. That makes 'q' DWIM in SLDB.
+
+2004-06-18  Matthew Danish  <mdanish at andrew.cmu.edu>
+
+	* swank-allegro.lisp (frame-source-location-for-emacs):
+	Implemented.
+
+2004-06-18  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-repl-return): If the user presses return on old
+	REPL input then take it and insert it as the current input.
+	Signal an error if the point is not on any input.
+	(slime-preserve-zmacs-region): Function to ensure that the current
+	command doesn't deactivate zmacs-region (XEmacs only).
+	(slime-repl-bol, slime-repl-eol): Use it.
+	(slime-kill-all-buffers): Changed buffer-name regexps for XEmacs
+	compatibility. The ",quit" shortcut now works in XEmacs.
+	(slime-display-message): Fixed call to `slime-typeout-message'
+	to handle formatting characters. Avoids errors on certain messages.
+	(slime-list-compiler-notes): Save the window configuration
+	earlier. This fixes an error under XEmacs when dismissing the
+	notes buffer.
+	(slime-recenter-window): Avoid moving the point. This keeps the
+	point in the right place when showing debugger-frame locations in
+	Emacs 21.
+
+2004-06-17  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-loader.lisp (binary-pathname): Place fasl files under
+	~/.slime/fasl/ instead of the SLIME installation directory. The
+	installation directory can now be read-only.
+	(binary-pathname, user-init-file): Removed Win32
+	conditionalization. The init file is now called ~/.swank.lisp
+	instead of ~/_swank.lsp.
+
+	* swank-lispworks.lisp (with-fairly-standard-io-syntax): New
+	macro. Like with-standard-io-syntax, but keeps the existing values
+	of *package* and *readtable*.
+	(dspec-stream-position): Use it.
+	(quit-lisp): Implemented.
+
+2004-06-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-set-default-directory): Don't call
+	slime-repl-update-banner in Emacs 20.
+	(slime-show-source-location, slime-recenter-window): Use
+	set-window-start instead of recenter; this avoids flickering.
+	(sldb-list-locals): Don't forget about slime-current-thread in the
+	temporary buffer.  (Fixes bug reported by Mike Beedle.)
+	(sldb-step): Re-enabled.  The CMUCL backend has rudimentary support
+	for stepping.
+
+	* swank.lisp (*readtable-alist*): Call backend function for
+	initialization.
+	(eval-for-emacs, guess-buffer-package): Signal a continuable error
+	if a package name was supplied but no such package exists.  Not
+	sure if this is better than what we did before (i.e. silently use
+	the current package).
+
+	* swank-cmucl.lisp (default-directory): Add implementation.
+	(sldb-step): Uncomment it and remove references to
+	*swank-debugger-condition*.
+
+	* swank-backend.lisp (sldb-step, default-readtable-alist): New
+	backend functions.
+	(emacs-connected): Pass the redirected stream as argument, so that
+	the OpenMCL backend can add it to CCL::*AUTO-FLUSH-STREAMS*.
+
+	* swank-sbcl.lisp (default-readtable-alist): Implement it.
+
+	* swank-loader.lisp: Move readtable-alist initialization to
+	swank-sbcl.lisp.
+
+	* swank-allegro.lisp (default-directory, call-with-syntax-hooks):
+	Add implementations as workarounds for ACL5 bugs.
+
+2004-06-16  Lawrence Mitchell <wence at gmx.li>
+
+	* slime.el (slime-maybe-rearrange-inferior-lisp): Call
+	`generate-new-buffer-name' manually, rather than relying on the
+	UNIQUE argument to `rename-buffer' to do so.
+
+2004-06-16  Frederic Brunel <frederic.brunel at in-fusio.com>
+
+	* slime.el (slime-startup-animation): Use defcustom to declare the
+	variable.
+	(slime-enable-startup-animation-p): Deleted.
+
+2004-06-16  Robert Lehr  <bozzio at the-lehrs.com>
+
+	* slime.el (slime-backend): This variable can now be set to an
+	absolute filename.
+
+2004-06-15  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-compile-file): Just prompt for saving the
+	current file instead of calling `save-some-buffers'. Based on a
+	patch from Brian Downing.
+
+2004-06-12  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* wank-allegro.lisp (format-sldb-condition, condition-references):
+	Add workarounds for buggy no-applicable-method.
+
+	* swank.lisp (parse-symbol, parse-package): Handle reader errors.
+
+	* swank-openmcl.lisp (send, receive): Ensure that messages are
+	never nil.
+
+2004-06-10  Christophe Rhodes <csr21 at cam.ac.uk>
+
+	* swank-sbcl.lisp (call-with-syntax-hooks): Add hooks to fix
+	"SB!"-style package names.
+	(shebang-readtable): Return a readtable with readermacros needed
+	to parse SBCL sources.
+
+	* swank.lisp (with-buffer-syntax): New macro.  This should be used
+	for code which needs to READ code from Emacs buffers.  *package*
+	and *readtable* are bound suitable values.
+	(to-string, format-values-for-echo-area, interactive-eval)
+	(eval-region, interactive-eval-region, re-evaluate-defvar)
+	(swank-pprint, pprint-eval, listener-eval)
+	(compile-string-for-emacs, disassemble-symbol, describe-to-string)
+	(describe-symbol, describe-function)
+	(describe-definition-for-emacs)
+	(documentation-symbol, init-inspector, inspect-nth-part)
+	(inspector-pop, inspector-next, describe-inspectee)
+	(inspect-current-condition): Use it.
+
+2004-06-10  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-loader.lisp: Initialize swank::*readtable-alist* for SBCL.
+
+	* swank-backend.lisp (default-directory, call-with-syntax-hooks):
+	New functions.
+
+	* swank.lisp (*readtable-alist*): New configurable.  The keys are
+	package name and the values readtables.  The readtable will be
+	used to READ code originating from Emacs buffers in the associated
+	slime-buffer-package.
+	(drop-thread): Simplified.
+	(*buffer-readtable*): New variable.
+	(parse-package): New function.
+	(parse-string): Renamed from symbol-from-string.  Make it case
+	insensitive.
+	(eval-for-emacs): Initialize the *buffer-readtable*.
+	(symbol-indentation): Don't consider symbols in the CL package.
+	Emacs already knows how to indent them.
+	(compile-file-if-needed): Used for REPL shortcut
+	'compile-and-load'.
+
+	* slime.el (pwd): Re-add REPL shortcut.
+	(slime-repl-push-directory, slime-repl-compile-and-load): Simplified.
+
+2004-06-10  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-step): Command is disabled because the function
+	`swank:sldb-step' that it calls doesn't exist. I don't see any
+	stepping code in our backends.
+
+2004-06-09  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-goto-location-position) [:function-name]: The
+	function name can also occur after a ?(, not only after
+	whitespace.
+
+	* (slime-init-output-buffer): Initialize the package stack.
+	Reported by Rui Patrocínio.
+
+	* (slime-completions): Make it consistent with
+	slime-simple-completions. The second argument was never supplied.
+	Reported by Rui Patrocínio.
+	
+2004-06-09  Eric Blood <eblood at winkywooster.org>
+
+	* slime.el (slime-indent-and-complete-symbol): Renamed from
+	slime-repl-indent-and-complete-symbol.
+
+	(slime-typeout-frame-properties): Add more default options for the
+	typeout frame--specifically it now has a default width, and moves
+	the typeout frame to the upper right.
+
+2004-06-09  Andras Simon <andras at renyi.hu>
+
+	* swank-abcl.lisp: New backend for Armed Bear Common Lisp.
+	
+	* swank-loader.lisp: Add ABCL support.
+
+2004-06-09  Martin Simmons <martin at xanalys.com>
+
+	* swank-lispworks.lisp (dspec-stream-position): New function to
+	make source location work for anything complicated e.g. methods.
+	(with-swank-compilation-unit): Refactoring.
+	(who-macroexpands): Implemented.
+	(list-callers): Implemented.
+
+	* swank-backend.lisp (network-error): Inherit from simple-error to
+	get correct initargs.
+
+2004-06-09  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-insert-references): Added support for hyperlinked
+	references as part of conditions being debugged. This is a new
+	feature in SBCL to reference appropriate sections of their manual
+	or CLHS from condition objects. The references are clickable.
+
+	* swank-backend.lisp (format-sldb-condition): New backend function
+	to format conditions for SLDB.
+	(condition-references): New function to return a list of
+	documentation references associated with a condition.
+
+	* swank.lisp (debugger-condition-for-emacs): Call the above
+	backend functions to add a `references' list for Emacs.
+
+	* swank-sbcl.lisp (format-sldb-condition, condition-references):
+	Implemented. Requires a recent (latest?) SBCL release.
+
+2004-06-08  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-cmucl.lisp (close-socket): Remove any SERVE-EVENT handlers
+	for the socket's file descriptor.
+
+	* swank-sbcl.lisp (close-socket): Same fix.
+
+2004-06-07  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-cmucl.lisp: Minor refactorings.
+
+2004-06-07  Edi Weitz  <edi at agharta.de>
+
+	* swank-allegro.lisp (call-with-compilation-hooks): Implemented.
+	Wrap IMPORT call in EVAL-WHEN.
+
+	* swank.lisp, swank-backend.lisp: Wrap EXPORT calls in
+	EVAL-WHEN. Fixes many warnings in ACL.
+
+2004-05-25  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-kill-without-query-p): Default to T.
+	(sldb-highlight): Variable to control face-based highlighting of
+	SLDB locations. (In Emacs21 the point is visible even in unselected
+	windows, which is sufficient for me.)
+	(sldb-show-location-recenter-arg): Argument to `recenter' when
+	showing SLDB locations. Default to nil, i.e. location appears in
+	the middle of the window.
+
+2004-05-24  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-input-complete-p): Return nil for unbalanced
+	sexps starting with quote ?', backquote ?`, or hash ?#.  C-j can
+	be used for more complicated cases.
+
+2004-05-22  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-repl-sayoonara): Added "quit" as an alias for
+	sayoonara.
+
+2004-05-22  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (arglist): Catch (reader) errors in
+	READ-ARGLIST.
+
+	* swank-allegro.lisp (fspec-primary-name): New function.
+	(find-fspec-location): Use it, if the start position cannot be
+	found.
+
+	* slime.el (slime-pprint-event): New function.
+	(slime-log-event): Use it.
+	(slime-reindent-defun): Indent the form after point, if point is
+	in the first column an immediately before a #\(.
+
+2004-05-21 Bill Clementson <Bill_Clementson at peoplesoft.com>
+
+	* slime.el (slime-switch-to-output-buffer): Use "P" as interactive
+	spec.
+	
+2004-05-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-switch-to-output-buffer): Override the
+	prefix-arg if we are called non-interactively.
+	(slime-repl-current-input): Don't add newlines.
+	(slime-repl-return): Send input if we are in read-mode also if it
+	isn't a complete expression.
+	(repl-read-lines): New test case.
+	(slime-enable-startup-animation-p): New configurable.
+	(slime-repl-update-banner): Use it.
+	(slime-hide-inferior-lisp-buffer): New function. Reuse the
+	*inferior-lisp* buffer window for the SLIME REPL.
+
+	* swank-allegro.lisp (find-fspec-location): Better handling of
+	methods.  From Bill Clementson.
+
+2004-05-17  Luke Gorrie  <luke at bluetail.com>
+
+	* xref.lisp, swank-clisp.lisp: Renamed XREF package to PXREF (P
+	for portable). This makes it possible to load the package in
+	e.g. CMUCL, which is nice because it's a good package.
+
+	* swank-cmucl.lisp: Some refactoring and high-level
+	commenting. Mostly just trying to organise things into fairly
+	self-contained sections (my new hobby, sad I know!)
+
+	* slime.el: Added `C-c C-e' as an alternative binding for
+	`slime-interactive-eval' (usually `C-c :'). This seems slightly
+	more convenient, and has the added bonus of clobbering an unwanted
+	`inf-lisp' binding.
+
+2004-05-14  Marco Baringer <mb at bese.it>
+
+	* slime.el (slime-with-output-to-temp-buffer): Now takes a
+	package arg specifying what slime-buffer-package should be in the
+	generated buffer. 
+	(slime-show-description): actually pass the package arg.
+	(slime-show-apropos): pass the package arg to
+	slime-with-output-to-temp-buffer.
+	(slime-list-repl-shortcuts): pass a package arg.
+	
+2004-05-12  Alan Ruttenberg  <alanr-l at mumble.net>
+	* swank-openmcl.lisp: Fixes to support openmcl 0.14.2 changes in
+	backtrace protocol, from Gary Byers.
+	- Replace string "tcr" to "context".
+	- Change the call to %current-tcr in map-backtrace to get-backtrace-context, 
+	defined so as to be back compatible with 0.14.1.
+	- Change the call to %catch-top to explicitly use %current-tcr
+	instead of the passed in tcr-which-is-now-called-context.
+
+	Users of map-backtrace (outside of slime code) note: The tcr position in the
+	function call is now occupied by the backtrace "context" which is always nil.
+	If you really need the tcr then you need to call %current-tcr yourself now.
+	
+	Gary comments: The part that's a little hard to document about
+	the new "context" stuff - used to walk the stacks of thread A from
+	thread B - is that thread B has to be aware of when a context
+	becomes invalid (a context describing part of thread A's stack is
+	valid while thread A's sitting in a break loop and becomes invalid
+	as soon as it exits that break loop.)  A thread sort of announces
+	when a context becomes valid and when it becomes invalid; whether
+	and how SWANK could hook into that isn't yet clear.
+
+	* swank-openmcl.lisp: Minor changes to backtrace display: Anonymous 
+	functions names in function position surrounded by #<>. Use prin1 instead of 
+	princ to print function arguments (so strings have "s around them). 
+	prefix symbol and list arguments by "'" to make them more look like a 
+	valid function call. Let me know if you don't like this...
+
+2004-05-12  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Fixes for outline-mode in *slime-events* from Edi
+	Weitz.
+
+2004-05-11  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-events-buffer): Disable outline-mode by default.
+	(slime-inhibit-ouline-mode-in-events-buffer): New variable.
+	(slime-expected-failures): Reduce the number for SBCL.
+	
+	* swank-sbcl.lisp (resolve-note-location): Resolve the location if
+	we are called by swank-compile-string.  The pathname argument is
+	never :stream in SBCL, so the method written for CMUCL was never
+	called.
+
+2004-05-10  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (from-string): Bind *READ-SUPPRESS* to NIL.
+	(swank-compiler): Bind a restart to abort compilation but still
+	report the compiler messages already trapped.
+	(string-to-package-designator): Function that uses READ to
+	case-convert package names.
+	(apropos-list-for-emacs): Use it.
+
+	* slime.el (slime-eval-with-transcript): Don't print the "=>"
+	prefix in messages showing evaluation results. It mucks up
+	alignment in multi-line messages.
+	(sldb-eval-in-frame): Don't print "==>" prefix on evaluation
+	results, for the same reason.
+	(slime-show-source-location): Move the point to the source
+	location in addition to highlighting the matching parens.
+
+2004-05-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (find-definitions): Add support for variables
+	and constants.
+
+2004-05-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-clisp.lisp (compiler-note-location): Use make-location to
+	instead of `(:location ...). This initializes the new hint slot
+	automatically.
+
+2004-05-07  Barry Fishman <barry_fishman at att.net>
+
+	* swank.lisp (prin1-to-string-for-emacs, arglist-to-string): CVS
+	CLISP prints NIL as |COMMON-LISP|::|NIL| if *print-readably* is
+	true.  Set *print-readably* to nil for a more Emacs friendly
+	printer syntax.
+
+2004-05-06   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-maybe-list-compiler-notes): Display the notes
+	listing after C-c C-c only if there are no annotations in the
+	buffer.  CMUCL creates usually one warning with an error location
+	and an almost redundant warning without at the end of the
+	compilation unit.  Don't display the listing in this common case.
+
+	(slime-reindent-defun): Pass nil as the third arument to
+	indent-region.
+
+2004-05-06  Marco Baringer <mb at bese.it>
+
+	* slime.el (slime-repl-sayoonara): Don't attempt to quit the lisp
+	if we're not connected.
+
+	* swank-openmcl.lisp (*buffer-offset*, *buffer-name*): Supply
+	default values. This avoids unbound value errors when compiling an
+	asdf system signals errors.
+	
+2004-05-04  Alan Shutko  <ats at acm.org>
+
+	* slime.el (slime-compiler-notes-show-details/mouse): New command.
+	(slime-compiler-notes-mode-map): Use it.
+
+2004-05-04   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (arglist): Handle byte-code functions better.
+	We don't know much about the actual argument list, only the number
+	of arguments.  Return at least something mildly interesting like
+	 (arg0 arg1 &optional arg2 ...)
+	(function-location): Special-case byte-code functions.
+
+	* swank-backend.lisp (with-struct): New macro.
+
+2004-05-04 Thomas F. Burdick  <tfb at OCF.Berkeley.EDU>
+
+	* slime.el (slime-reindent-defun): New command on C-M-q. Reindent
+	the current Lisp defun after trying to close any unmatched
+	parenthesis. If used within a comment it just calls fill-paragraph.
+
+2004-05-04  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-goto-location-position): Regexp fix.
+	(slime-reindent-defun): New command on M-q. Reindent the current
+	Lisp defun after trying to close any unmatched parenthesis.
+
+	* swank.lisp: Remove (declaim (optimize ...)). The side-effect
+	this has on people's environment seems harmful (I saw someone
+	having trouble on the OpenMCL list).
+
+	* swank-cmucl.lisp (source-location-from-code-location): Fixed a
+	bug where the source-file-cache was not really used.
+	Now always report the location based on source file (cached or
+	not) even if modified -- not falling back on regexps, which was
+	probably a misfeature.
+
+	* slime.el: Remove `slime-cleanup-definition-refs'.
+
+2004-05-02   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-start-and-load): New command.  Suggested by
+	Lars Magne Ingebrigtsen.
+
+2004-05-02  Lars Magne Ingebrigtsen  <larsi at netfonds.no>
+
+	* slime.el (slime-kill-without-query-p): New variable.
+	(slime-net-connect): Use it.
+	(slime-open-stream-to-lisp): Ditto.
+	(slime-maybe-start-lisp): Ditto.
+
+2004-05-02  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-goto-source-location): Added support for the
+	:snippet "hint" in a location specifier. If Lisp sends the
+	(initial) source text for the definition then Emacs isearches for
+	it in both directions from the given character position. This
+	makes M-. robust when the Emacs buffer has been edited. Requires
+	backends to provide this snippet information.
+	(slime-goto-location-position): Tightened up the regular
+	expressions for :function-name style location search.
+	(slime-cleanup-definition-refs): New function to do a little
+	post-processing on definition references from Lisp. Mostly this is
+	a hack: if POSITION is NIL then we fill it in with the function
+	name, ready for regexp search. I was in a hurry and it was easier
+	to do here, and it doesn't seem entirely unreasonable.
+
+	* swank-backend.lisp (:location): Added a 'hints' property list
+	to the location structure. This is for extra information that
+	compliments the buffer/position.
+
+	* swank-cmucl.lisp (code-location-stream-position): Position the
+	argument stream at the definition before returning.
+	(source-location-from-code-location): Include the :snippet hint
+	for Emacs (see above). The snippet will only be accurate provided
+	that the source file on disk has not been modified.
+	(*source-file-cache*) The contents of all source files consulted
+	for M-. are now cached if they match the version of the running
+	code. This is so that we can accurately lookup source locations
+	even when the file is modified, provided we manage to get the
+	right version (by file timestamp) at least once.
+	(source-location-from-code-location): If the right source version
+	is not available on disk or in our cache then let Emacs fall back
+	on a regular expression search.
+
+2004-05-01   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (find-top-frame): New function used to hide
+	debugger-internal frames.
+	(call-with-debugging-environment): Use it.
+
+2004-05-01  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-abort): Print a message if the Emacs RPC
+	returns. It shouldn't, if ABORT manages to unwind the stack, but
+	it currently does in OpenMCL due to some bug.
+	(slime-edit-definition-fallback-function): Name of a function to
+	try if the builtin edit-definition finding fails. You can set
+	this to `find-tag' to fall back on TAGS.
+
+	* swank.lisp (list-all-systems-in-central-registry): Use explicit
+	:wild in pathname for matching (needed in at least SBCL).
+
+	* swank-openmcl.lisp: Removed obsolete `swank-compile-system'.
+
+	* swank-sbcl.lisp: Removed obsolete `swank-compile-system'.
+	Removed some stale comments about supported features.
+
+2004-04-30   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-update-banner): Don't print the working
+	directory.  It rarely fits in a line and was only Emacs'
+	default-directory.  M-x pwd is convenient enough.
+
+	* swank.lisp (symbol-indentation): Don't infer indentation for
+	symbols starting with 'def' or 'with-'.  It was wrong most of the
+	time and Emacs' defaults are better.
+
+	* swank-lispworks.lisp (emacs-connected): Add methods to
+	stream-soft-force-output for socket-streams and
+	slime-output-streams.  This flushes those streams automatically
+	(i assume it gets called when Lisp is idle).
+
+2004-04-29   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-mode): Set slime-current-thread to
+	:repl-thread.
+
+	* swank.lisp (thread-for-evaluation, dispatch-event): Accept
+	:repl-thread as thread specifier and dispatch evaluation and
+	interrupt request properly.
+	(repl-thread-eval, repl-eval): Deleted. We do the special casing in
+	thread-for-evaluation.
+
+2004-04-29  Lars Magne Ingebrigtsen  <larsi at netfonds.no>
+
+	* slime.el (slime-event-buffer-name): New variable.
+	(slime-events-buffer): Use it.
+	(slime-space-information-p): Ditto.
+	(slime-space): Use it.
+	(slime-reply-update-banner-p): Ditto.
+	(slime-repl-update-banner): Use it.
+
+2004-04-28   Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-loader.lisp (*lisp-name*): Add versioning support for
+	CLISP.
+
+	* swank-clisp.lisp (arglist): Trap exceptions and return
+	:not-available in that case.
+
+	* swank.lisp (arglist-for-insertion): Don't use ~< ..~:@>.
+	CLISP's pretty printer can't handle it.
+
+2004-04-28  Luke Gorrie  <luke at bluetail.com>
+
+	* NEWS: Created a NEWS file for recording changes that we want
+	users to read about.
+
+	* slime.el (slime-log-event): Use outline-minor-mode in
+	*slime-events* instead of hideshow-mode. It's more
+	reliable. (Patch from Lawrence Mitchell.)
+
+2004-04-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-net-connect): Bind inhibit-quit to nil, so that
+	we have a chance to interrupt Emacs if open-network-stream blocks.
+	(slime-complete-maybe-restore-window-configuration): Keep trying
+	after slime-repl-indent-and-complete-symbol.
+	(slime-space): Don't close the completion buffer.  We don't know
+	the window-config before the completion, so leave the buffer open.
+
+	* swank.lisp (create-server): New keyword based variant to start
+	the server in background.
+	(setup-server): Add support to keep the socket open for
+	single-threaded Lisps.
+	
+2004-04-27  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi (Other configurables): Updated instructions on
+	globally installing SLDB on *debugger-hook*.
+
+	* slime.el (slime-log-event): Better bug-avoidance with
+	hs-minor-mode. Hopefully XEmacs users can rest safely now.
+	(slime-prin1-to-string): Bind `print-escape-newlines' to nil.
+	(slime-set-connection-info): Commented out call to
+	`slime-check-protocol-version'. Let's see how we do without it.
+	(slime-oneway-eval): Removed unused function.
+
+	* swank.lisp (oneway-eval-string): Removed unused function.
+
+2004-04-26  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp: Move definition of `with-io-redirection' above
+	`with-connection' to avoid a CLISP error. This is really weird.
+	(interactive-eval): Bind *package* to *buffer-package*, so that
+	`C-x C-e' and related commands evaluate in the expected package.
+
+	* slime.el (sldb-insert-frames): Handle empty backtrace (I got one
+	in CLISP).
+
+	* swank-allegro.lisp (arglist): Return :not-available if arglist
+	lookup fails with an error.
+
+	* slime.el: Moved snippets of Common Lisp code into swank.lisp
+	from the thread control panel. (Remember, no CL code in slime.el!)
+
+	* swank-loader.lisp (*lisp-name*): Include a short version number
+	in the Lisp name to separate FASL files for different
+	versions. Only implemented for CMUCL and SBCL sofar.
+
+	* swank.lisp (ed-in-emacs): Avoid mutating the argument.
+	(spawn-repl-thread): Add a new thread for evaluating REPL
+	expressions. This same thread is used for all REPL
+	evaluation. This fixes some issues with variables like * and **
+	in at least SBCL.
+
+	* nregex.lisp: Typo fix (thanks Barry Fishman).
+
+	* slime.el (slime-events-buffer): Don't use hideshow-mode in
+	XEmacs for the *slime-events* buffer. It causes obscure problems
+	for some users. Still used in GNU Emacs.
+
+2004-04-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-backend.lisp (arglist): Return a list or :not-available.
+	Don't return strings or raise exceptions.
+
+	* swank.lisp (arglist-for-echo-area): Simplified and adapted for
+	the new semantic of ARGLIST.
+	(arglist-for-insertion): Now a separate function.
+	(read-arglist): Deleted. No longer needed.
+
+	* swank-cmucl.lisp, swank-lispworks.lisp (arglist): Return
+	:not-available if the arglist cannot be determined.
+
+	* slime.el (slime-set-connection-info): Hide the *inferior-lisp*
+	buffer here, so that we have all the buffer rearrangement in one
+	place.
+	(slime-insert-arglist): Use swank:arglist-for-insertion.
+
+2004-04-24  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-init-connection-state): Use an asynchronous RPC
+	instead of slime-eval to reduce the amount of work we do in the
+	timer function.  We can remove the workaround for the timer
+	problem.
+
+2004-04-23  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Updated top comments.
+	Make SLIME faces inherit from their font-lock cousins properly.
+	(slime-connect): Bind `slime-dispatching-connection' to avoid
+	being confused by old buffer-local variables when initializing
+	the connection. This fixes a bug where doing `M-x slime' from the
+	REPL could give a "Not connected" error.
+
+2004-04-22  Edi Weitz <edi at agharta.de>
+
+	* slime.el (slime-read-system-name): Perform completion on all
+	systems in the central registry.
+
+	* swank.lisp (list-all-systems-in-central-registry): New function.
+	
+2004-04-22  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-update-banner): Add workaround to force the
+	proper behavior of the the first command in the REPL buffer.
+	(slime-repl-shortcut-history): Define the variable to make XEmacs
+	happy.
+
+2004-04-22  Tiago Maduro-Dias <tcmd at rnl.ist.utl.pt>
+
+	* slime.el (slime-space): Cleanup.
+	(slime-complete-restore-window-configuration): Use
+	slime-close-buffer instead of bury-buffer.
+
+2004-04-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Suppress byte-compiler warnings by binding
+	byte-compiler-warnings to nil.
+	(slime-repl-shortcut): Use a structure instead of a list for the
+	short cut info.  Update the users accordingly.
+
+	* swank-cmucl.lisp (arglist): Return a list instead of the string.
+
+2004-04-21  Edi Weitz <edi at agharta.de>
+
+	* slime.el (slime-apropos): Add support for regexp-based apropos.
+	We use nregex, so the regexp syntax is different from Emacs'
+	regexps and bit restricted (alternation '|' and optional groups
+	'(xy)?' are not implemented).
+ 	(slime-insert-arglist): New command - stolen from ILISP. I always
+	thought this was quite useful. 
+	(slime-oos): Fix typo.
+
+	* swank.lisp (apropos-symbols): Use regexp and support
+	case-sensitive matching.
+	(arglist-for-echo-area): New argument to control if the operator
+	name should be included.
+
+	* nregex.lisp: New file.
+
+	* swank-loader.lisp (*sysdep-pathnames*): Load it.
+
+2004-04-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* doc/slime.texi (Compilation): slime-remove-notes is bound to C-c
+	M-c not M-c.  Noted by Edi Weitz.
+	
+2004-04-21  Edi Weitz <edi at agharta.de>
+
+	* swank.lisp (list-all-package-names): Optionally include
+	nicknames in the result.
+
+	* slime.el (slime-read-package-name): Include nicknames in the
+	completions set.
+	(slime-repl-mode-map): Bind C-c : to slime-interactive-eval just
+	like in most other SLIME buffers.
+	(read-directory-name): Compatibilty defun.
+	
+2004-04-20  Tiago Maduro-Dias <tcmd at rnl.ist.utl.pt>
+
+	* slime.el (slime-close-buffer): New utility function.
+	(slime-space): Use it to kill superfluous *Completions* buffers.
+
+2004-04-17  Raymond Toy <rtoy at earthlink.net>
+
+	* swank-cmucl.lisp (source-location-tlf-number)
+	(source-location-form-number): New functions to extract the
+	encoded form-numbers from source locations.
+	(resolve-stream-source-location, resolve-file-source-location):
+	Use them.
+
+2004-04-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-merge-notes): Use mapconcat instead of
+	(concat (slime-intersperse (mapcar ....)))
+	(slime-intersperse): Handle empty lists.
+
+2004-04-16  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/Makefile: Added 'install' and 'uninstall' targets for the
+	Info manual. It may be necessary to tweak `infodir' in the
+	Makefile to suit the local system before installing. (Patch from
+	from Richard M Kreuter.)
+
+	* doc/slime.texi (Top): The Top node is now smaller, with details
+	moved into Introduction. This makes the Info front page easier to
+	navigate. (Patch from Richard M Kreuter.)
+
+2004-04-15  Ivan Boldyrev  <email at secret-by-request>
+
+	* slime.el (slime-handle-repl-shortcut): Call `completing-read'
+	with an alist as expected, using `slime-bogus-completion-alist'.
+
+2004-04-14  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi (Shortcuts): Described REPL shortcuts.
+
+	* slime.el (slime-oos): Generic ASDF interface.
+	(force-compile-system, compile-system, load-system,
+	force-load-system): New REPL commands.
+
+	* swank-backend.lisp (operate-on-system): More generic interface
+	to ASDF.
+
+	* swank.lisp (operate-on-system-for-emacs): More generic
+	interface to ASDF.
+
+	* slime.el (slime-repl-mode-map): Portability fix for definition
+	of the REPL command character.
+	(slime-maybe-rearrange-inferior-lisp): Bugfix for running
+	multiple inferior lisps.
+
+2004-04-13  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-handle-repl-shortcut,
+	slime-list-all-repl-shortcuts, slime-lookup-shortcut,
+	defslime-repl-shortcut): Refactor repl shortcut code to provide a
+	more leggible help.
+
+2004-04-09  Lawrence Mitchell  <wence at gmx.li>
+
+	* slime.el (slime-same-line-p): Use `line-end-position', rather
+	than searching for a newline manually.
+	(slime-repl-defparameter): Use VALUE, not VALUE-FORM.
+
+2004-04-08  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-repl-package-stack): New buffer local variable.
+	(slime-repl-directory-stack): New buffer local variable.
+	(slime-repl-command-input-complete-p): Remove.
+	(slime-repl-update-banner): New function.
+	(slime-init-output-buffer): Use slime-repl-update-banner.
+	(slime-repl-shortcut-dispatch-char): New variable.
+	(slime-repl-return): Don't check for repl commands anymore.
+	(slime-repl-send-repl-command): Remove.
+	(slime-repl-mode-map): Bind slime-repl-shortcut-dispatch-char to
+	slime-handle-repl-shortcut.
+	(slime-set-default-directory): Use read-directory-name, call
+	slime-repl-update-banner.
+	(slime-repl-shortcut-table): New global variable.
+	(slime-handle-repl-shortcut): New function.
+	(defslime-repl-shortcut): New macro for defining repl shortcuts.
+	(slime-repl-shortcut-help, "change-directory",
+	slime-repl-push-directory, slime-repl-pop-directory,
+	"change-package", slime-repl-push-package, slime-repl-pop-package,
+	slime-repl-resend, slime-repl-sayoonara, slime-repl-defparameter,
+	slime-repl-compile-and-load): New repl shortcuts.
+	(slime-kill-all-buffers): Kill sldb buffers as well.
+
+	* swank.lisp: Remove the repl related functions.
+	(requires-compile-p): New function.
+	
+2004-04-07  Lawrence Mitchell  <wence at gmx.li>
+
+	* slime.el (slime-repl-prompt-face): New face.
+	(slime-repl-insert-prompt): Use it.
+	(slime-with-chosen-connection, with-struct): Docstring
+	fix for function's arglist display.
+	(when-let, slime-with-chosen-connection, with-struct): Docstring
+	fix for function's arglist display.
+	(slime-read-package-name): Use `slime-bogus-completion-alist' to
+	construct completion table.
+	(slime-maybe-rearrange-inferior-lisp): Use `rename-buffer's
+	optional argument to rename uniquely.
+	(slime-check-connected): Display keybinding for `slime' via
+	`substitute-command-keys'.
+	(slime-repl-send-repl-command): Use whitespace character class in
+	regexp.
+	(slime-autodoc-stop-timer): New function.
+	(slime-autodoc-mode): Add `interactive' spec to specify optional
+	arg.  This allows prefix toggling of mode (behaves more like
+	most Emacs modes now).  Stop timer if switching mode off with
+	`slime-autodoc-stop-timer'.
+	(slime-autodoc-start-timer, slime-complete-symbol)
+	(slime-complete-saved-window-configuration)
+	(slime-insert-balanced-comments): Docstring fix.
+	(slime-ed): Call `slime-from-lisp-filename' on filename for list
+	case of argument.
+	(slime-insert-transcript-delimiter, slime-thread-insert): Use
+	?\040 to indicate SPC.
+	(line-beginning-position): `forward-line' always puts us in
+	column 0.
+	(line-end-position): Define if not fboundp (for older XEmacs).
+
+2004-04-07  Peter Seibel  <peter at javamonkey.com>
+
+	* swank-allegro.lisp (set-default-directory): Allegro specific
+	version that also uses excl:chdir.
+
+	* swank.lisp (swank-pprint): Add swank versions of two missing
+	pretty-printer control variables.
+
+2004-04-07  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (completion-set): Also complete package
+	names. (Patch from Sean O'Rourke.)
+	(find-matching-packages): Add a ":" to the end of package names
+	in completion.
+
+2004-04-06  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-bytecode-stale-p): Automatically check if
+	slime.elc is older than slime.el and try to help the user out if
+	so.
+
+2004-04-06  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-repl-command-input-complete-p): New function.
+	(slime-repl-send-string): New optional arg specifying what string
+	to put on slime-repl-input-history, usefull when this string
+	differs from what we actually want to eval.
+	(slime-repl-return): Check for repl commands and pass then to
+	slime-repl-send-repl-command.
+	(slime-repl-send-repl-command): New function.
+	(slime-kill-all-buffers): New function.
+	
+	* swank.lisp: Define the various repl command handlers: sayoonara,
+	cd, pwd, pack and cload.
+	
+	* swank-backend.lisp (quit-lisp): Define as part of the backend
+	interface and export.
+	
+	* swank-sbcl.lisp, swank-openmcl.lisp, swank-cmucl.lisp,
+	swank-clisp.lisp, swank-allegro.lisp (quit-lisp): implement.
+
+2004-04-06  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (macro-indentation): Check that the arglist is
+	well-formed. This works around a problem with ACL returning
+	arglists that aren't real lambda-lists.
+
+2004-04-05  Lawrence Mitchell  <wence at gmx.li>
+
+	* swank.lisp (*swank-pprint-circle*, *swank-pprint-escape*)
+	(*swank-pprint-level*, *swank-pprint-length*): Fix typo in
+	docstring.
+
+	* slime.el (slime-arglist): Don't `message' arglist directly, in
+	case it contains %-signs.
+	(slime-repl-output-face): Fix quoting.
+	(slime-symbol-at-point): Call `slime-symbol-name-at-point',
+	rather than ourselves.
+	(slime-check-protocol-version): Docstring fix.
+
+2004-04-05  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi (Semantic indentation): Documented new
+	automatically-learn-how-to-indent-macros feature.
+	Added auto version control header in subtitle.
+
+	* slime.el (slime-close-parens-at-point): New command bound to
+	C-a C-a. Inserts close-parenthesis characters at point until the
+	top-level form becomes well formed. Could perhaps be made fancier.
+	(slime-update-indentation): New command to update indentation
+	information (`common-lisp-indent-function' properties) based on
+	macro information extracted from Lisp. This happens
+	automatically, the command is just to force a full rescan.
+
+	* swank.lisp (connection): Added slots to track indentation caching.
+	(*connections*): List of all open connections.
+	(default-connection): Function to get a "default"
+	connection. This is intended to support globally using the
+	debugger hook outside the context of a SLIME request, which is
+	broken at present.
+	(with-connection): Don't setup a restart: that must be done
+	separately.
+	(sync-state-to-emacs): Call `update-connection-indentation'.
+	(update-connection-indentation): Automatically discover how to
+	indent macros and tell Emacs.
+
+	* swank-backend.lisp (arglist): Specify that strings returned
+	from ARGLIST should be READable.
+
+2004-04-02  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-maybe-list-compiler-notes): Display the notes
+	for C-c C-c, when there are notes without a good source-location.
+
+2004-04-01  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-sbcl.lisp: Remove the non-working workarounds for
+	non-existent fcntl.  Reported by Brian Mastenbrook.
+	(preferred-communication-style): Use multithreading if futexes are
+	available, sigio if fcntl is present, and fd-handlers otherwise.
+	(resolve-note-location): Don't try to construct a source-location
+	if there's no context.  Notes without location will be displayed
+	in the note-listing buffer.
+
+2004-04-01  Bill Clementson <Bill_Clementson at peoplesoft.com>
+
+	* swank-allegro.lisp (send): Fix misplaced parens.
+
+2004-03-31  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (debug-function-arglist): Return symbols if
+	possible.
+	(class-location): Support for experimental source-location
+	recording.
+
+2004-03-30  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-result-face): New face.
+	(slime-inspector-mode-map): Add a binding for M-.
+	(compile-defun): Add test case for escaped double quotes inside a
+	string.
+
+	* swank.lisp (ed-in-emacs): New allowed form for argument.
+	(pprint-eval-string-in-frame): Apply arguments in proper order.
+
+	* swank-cmucl.lisp (method-dspec): Include method-qualifiers.
+	(class-definitions): Renamed from struct-definitions.  Try to
+	locate condition-classes and PCL classes (in the future).
+	(debug-function-arglist): Insert &optional, &key, &rest in the
+	right places.
+	(form-number-stream-position): Make it a separate function.
+
+2004-03-29  Lawrence Mitchell  <wence at gmx.li>
+
+	* swank.lisp (ed-in-emacs): New allowed form for argument.
+
+	* slime.el (slime-ed): Deal with list form of argument.  For a
+	list (FILENAME LINE [COLUMN]), visit the correct line and column
+	number.
+
+2004-03-29  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-source-path-parser.lisp (cmucl-style-get-macro-character):
+	New function. Workaround for bug(?) in SBCL.
+	(make-source-recording-readtable): Use it.
+
+2004-03-29  Luke Gorrie  <luke at bluetail.com>
+
+	* HACKING: Some small updates (more needed).
+
+	* slime.el (slime-inspector-buffer): Enter `slime-inspector-mode'
+	after `slime-mode'. This seems to give priority of keymap to the
+	inspector, so that it can override SPC.
+	(slime-easy-menu): Add slime-switch-to-output-buffer.
+	Enable SLIME menu in the REPL buffer.
+	(slime-symbol-name-at-point): Avoid mistaking the REPL prompt for
+	a symbol.
+	(slime-words-of-encouragement): A few new ones.
+	(slime-insert-xrefs): Removed the final newline from XREF
+	buffers. This helps to avoid unwanted scrolling.
+
+	* doc/slime.texi: Added a section about user-interface
+	conventions and our relationship with inf-lisp.
+
+2004-03-27  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-changelog-date): Reinitialize it at load-time.
+	This avoids the need to restart Emacs (horror!) after an update.
+
+	* swank-cmucl.lisp (debug-function-arglist): Properly reconstruct
+	the arglist from the debug-info. (Not complete yet.)
+	(arglist): Use it.
+
+	* swank-lispworks.lisp (spawn): Remove CL symbols from
+	mp:*process-initial-bindings*, to avoid the irritating behavior
+	for requests executed in different threads.  E.g., when someone
+	tries to set *package*.
+
+	* swank.lisp (*log-io*): New variable.  Bind it to *terminal-io*
+	at load-time, so we can log to a non-redirected stream.
+	(disassemble-symbol): Allow generalized function names.
+	(apropos-symbols): Handle the PACKAGE argument properly to get
+	useful output for C-c P.
+
+	* slime.el (slime-repl-indent-and-complete-symbol): New command.
+	Bound to TAB in the REPL mode.  First try to indent the current
+	line then try to complete the symbol at point.
+	(slime-dispatch-event): Ignore a unused thread variable to keep
+	XEmacs' byte compiler quiet.
+
+	* swank-sbcl.lisp (enable-sigio-on-fd): Use sb-posix::fcntl
+	instead of sb-posix:fcntl to avoid the ugly reader hack.  SBCL
+	doesn't have package locks and even if they add locks in the
+	future sb-posix::fcntl will still be valid.
+	(getpid): Use defimplementation instead of defmethod.
+	(function-definitions): Take generalized function names ala '(setf
+	car)' as argument.
+
+2004-03-26  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-group-similar): Bugfix: return NIL if the input
+	list is NIL.
+	(slime-inspector-buffer): Enter `slime-inspector-mode' after
+	`slime-mode'. This seems to give priority of keymap to the
+	inspector, so that it can override SPC.
+
+2004-03-26  Bjørn Nordbø <bn at telenor.net>
+
+	* swank.lisp (print-arglist): Updated to handle arglists with
+	string elements, causing arglists for macros to display properly
+	in LW 4.1.
+
+2004-03-26  Marco Baringer <mb at bese.it>
+
+	* swank-cmucl.lisp (set-default-directory): Define only once;
+	define with defimplementation, not defun.
+
+2004-03-26  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-merge-notes-for-display): New function to merge
+	together compiler notes that refer to the same location. This is
+	an optimization for when there are a lot of compiler notes:
+	`slime-merge-note-into-overlay' concat'd messages together one by
+	one in O(n^2) time/space, and became noticeably slow in practice
+	with ~100 notes or more.
+	(slime-tree-insert): This function is now automatically
+	byte-compiled (good speed gain).
+	Wrap byte-compilation in `save-window-excursion' to avoid showing
+	an unwanted warnings buffer (in XEmacs).
+
+2004-03-25  Bjørn Nordbø <bn at telenor.net>
+
+	* swank-lispworks.lisp: (create-socket, set-sigint-handler)
+	(who-references, who-binds, who-sets): Add backward compatibility
+	for LW 4.1.
+	(dspec-buffer-position): Fix inappropriate use of etypecase.
+
+2004-03-24  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-sbcl.lisp (getpid): Use sb-posix:getpid.
+
+	* slime.el (slime-inspector-mode-map): Added SPC as extra binding
+	for slime-inspector-next (like info-mode).
+
+	* doc/slime.texi: Added completion style and configuration.
+
+2004-03-23  Alan Shutko  <ats at acm.org>
+
+	* swank-clisp.lisp (set-default-directory): New function.
+
+2004-03-23  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp (send): Wait a bit if there are already many
+	message in the mailbox.
+
+	* swank-clisp.lisp (xref-results): Use fspec-location instead of
+	the of fspec-source-locations.  Reported by Alan Shutko.
+	(break): Be friendly to case-inverting readtables.
+
+	* swank-lispworks.lisp (emacs-connected): Add default method to
+	environment-display-notifier.  Reported by Bjørn Nordbø.
+	(set-default-directory, who-specializes): Implemented for
+	Lispworks.
+	(gfp): New function.
+	(describe-symbol-for-emacs, describe-definition): Distinguish
+	between ordinary and generic functions.
+	(call-with-debugging-environment): Unwind a few frames.  Looks
+	better and avoids the problems with the real topframe.
+	(interesting-frame-p): Use Lispworks dbg:*print-xxx* variables to
+	decide which frames are interesting.
+	(frame-actual-args): New function.
+	(print-frame): Use it.
+
+	* swank.lisp (open-streams, make-output-function): Capture the
+	connection not only the socket.  This way the streams can be used
+	from unrelated threads.  Reported by Alain Picard.
+	(create-connection): Factorized.  Initialize the streams after the
+	connection is created.
+	(initialize-streams-for-connection, spawn-threads-for-connection):
+	New functions.
+	(with-connection): Fix quoting bug and move upwards before first
+	use.
+	(guess-package-from-string): Add kludge for SBCL !-package names.
+	(apropos-list-for-emacs): Lispworks apparently returns duplicates;
+	remove them.
+	(inspect-object): Princ the label to allow strings and symbols.
+	(send-output-to-emacs): Deleted.
+	(defslimefun-unimplemented): Deleted.  Was unused.
+
+	* slime.el (slime-easy-menu): Add some more commands.
+	(slime-changelog-date): New variable. Initialized with the value
+	returned by the function of the same name.  This detects
+	incompatible versions if Emacs has not been restarted after an
+	upgrade.
+	(slime-check-protocol-version, slime-init-output-buffer): Use it.
+	(slime-events-buffer, slime-log-event): Use fundamental mode
+	instead of lisp-mode to avoid excessive font-locking for messages
+	with lots of strings.
+
+2004-03-22  Luke Gorrie  <luke at bluetail.com>
+
+	* doc/slime.texi: New user manual.
+
+	* swank.lisp (*communication-style*): New name for
+	*swank-in-background*.
+	Exported configuration variables: *communication-style*,
+	*log-events*, *use-dedicated-output-stream*.
+
+2004-03-20  Julian Stecklina <der_julian at web.de>
+
+	* swank-sbcl.lisp (+o_async+, +f_setown+, +f_setfl+): Add correct
+	constants for FreeBSD.
+
+2004-03-19  Alan Shutko  <ats at acm.org>
+
+	* swank.lisp, swank-loader.lisp: Take into account
+	`pathname-device' when deriving paths. A fix for Windows.
+
+2004-03-19  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-connected-hook): New hook called each time SLIME
+	successfully connects to Lisp. This is handy for calling
+	`slime-ensure-typeout-frame', if you want to use that feature.
+	(sldb-print-condition): New command to print the SLDB condition
+	description into the REPL, for reference after SLDB exits. Can be
+	called from `sldb-hook' if you want the condition to always be
+	printed. Bound to 'P' in SLDB.
+
+2004-03-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (format-values-for-echo-area): Bind *package* to
+	*buffer-package*.
+	(load-system-for-emacs): Renamed from swank-load-system.
+	(carefully-find-package): Be friendly to case inverting
+	readtables.
+	(inspect-current-condition): New function.
+
+	* swank-backend.lisp, swank-cmucl.lisp (set-default-directory):
+	New backend function.  
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-lispworks.lisp,
+	swank-sbcl.lisp (swank-compile-string): Be friendly to
+	case-inverting readtables.
+
+	* slime.el (sldb-inspect-condition): Use
+	swank:inspect-current-condition.
+	(slime-inspector-label-face): Make it bold by default.
+	(slime-check-protocol-version, slime-process-available-input):
+	Wait 2 secs after displaying the error message.
+	(sldb-list-catch-tags, sldb-show-frame-details): Display catch
+	tags as symbols not as strings.
+
+2004-03-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-dispatch-event, slime-rex): Pass a form instead
+	of a string with :emacs-rex.
+	(slime-connection-name): New connection variable.  Use it in
+	various places instead of slime-lisp-implementation-type-name.
+
+	* swank.lisp: Better symbol completion for case-inverting
+	readtables.  (Thanks Thomas F. Burdick for suggestions.)
+	(output-case-converter): New function.
+	(find-matching-symbols): Case convert the symbol-name before
+	comparing.
+	(compound-prefix-match, prefix-match-p): Use char= instead of
+	char-equal.
+	(case-convert-input): Renamed from case-convert.
+	(eval-for-emacs): Renamed from eval-string.  Take a form instead
+	of a string.
+	(dispatch-event, read-from-socket-io): Update callers.
+	(eval-region, interactive-eval): Use fresh-line to reset the column.
+
+2004-03-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-space): Send a list of the operator names
+	surrounding point to Lisp.  Lisp can use the list to select the
+	most suitable arglist for the echo area.  Suggested by Christophe
+	Rhodes and Ivan Boldyrev.
+	(slime-enclosing-operator-names): New function.
+
+	* swank.lisp (arglist-for-echo-area): Renamed from arglist-string.
+	(format-arglist-for-echo-area, arglist-to-string): New functions.
+
+2004-03-12  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-backend.lisp (find-definitions): Fix docstring.
+
+	* slime.el (slime-dispatch-event): Re-enable :ed command.
+	(sldb-return-from-frame): Send swank:sldb-return-from-frame.
+
+	* swank-cmucl.lisp (find-definitions): Allow names like (setf car).
+
+	* swank.lisp (sldb-return-from-frame): Convert the string to a
+	sexp.
+	(dispatch-event, send-to-socket-io): Allow %apply events.
+	(safe-condition-message): Bind *pretty-print* to t.
+	(set-default-directory): Use the truename.
+	(find-definitions-for-emacs): Allow names like (setf car).
+
+2004-03-12  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank.lisp (:swank): Export startup-multiprocessing,
+	restart-frame, return-from-frame.
+	What about kill-thread and interrupt-thread, which are accessed
+	as internal symbols?
+
+2004-03-10  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (struct-definitions, find-dd)
+	(type-definitions, function-info-definitions)
+	(source-transform-definitions, setf-definitions): New funtions.
+	(find-definitions): Include struct definitions, deftypes, setf
+	defintions, compiler-macros and compiler transforms.
+
+2004-03-10  Andras Simon <andras at renyi.hu>
+
+	* swank.lisp (print-arglist): Use with-standard-io-syntax.
+
+2004-03-10  Pawel Ostrowski  <pasza at zodiac.mimuw.edu.pl>
+
+	* swank-cmucl.lisp (unprofile-all): (eval '(profile:unprofile))
+	instead of just calling it since it is a macro in cmucl.
+
+	* swank.lisp (:swank): export profile symbols (profiled-functions,
+	profile-report, profile-reset, unprofile-all, profile-package)
+
+2004-03-10  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp, swank-lispworks.lisp, swank-sbcl.lisp,
+	swank-clisp.lisp, swank-cmucl.lisp (find-definitions): Some
+	tweaking.
+
+	* swank.lisp (print-arglist): Bind *pretty-circle* to nil to avoid
+	output like "(function . (cons))".  Suggested by Michael Livshin.
+	(test-print-arglist): Re-enable the tests.
+	(find-definitions-for-emacs): Renamed from
+	find-function-locations.
+
+	* slime.el (slime-edit-definition): Renamed from
+	slime-edit-fdefinition.  Display the dspec if there are multiple
+	definitions.
+	(slime-symbol-name-at-point): Handle the case when there is no
+	symbol at point.
+	(slime-expected-failures): New function
+	(slime-execute-tests): Use it.
+
+2004-03-09  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (frame-source-location-for-emacs): Export it.
+	Reported by Jouni K Seppanen
+	(test-print-arglist): Disable the tests until we know what's wrong
+	with print-arglist.  Reported by Michael Livshin.
+
+	* swank-source-path-parser.lisp, swank-gray.lisp (in-package): We
+	are in-package :swank-backend.  Thanks to Raymond Wiker.
+
+	Merge package-split branch into main trunk.
+	
+	* swank-clisp.lisp (find-fspec-location): Handle "No such file"
+	errors.
+
+	* swank-openmcl.lisp (preferred-communication-style): Implemented.
+	(call-without-interrupts, getpid): Use defimplementation.
+	(arglist, swank-compile-file, swank-compile-string)
+	(swank-compile-system, backtrace): Renamed.
+	(print-frame): New function.
+	(frame-catch-tags): Don't exclude nil source location.
+	(format-restarts-for-emacs, debugger-info-for-emacs,
+	inspect-in-frame). deleted
+	(frame-arguments): Don't use to-string.
+	(find-source-locations, find-function-locations
+	(method-source-location): Deleted.
+	(canonicalize-location, find-definitions,
+	function-source-location, list-callers): Use
+	ccl::edit-definition-p and
+	ccl::get-source-files-with-types&classes.  Makes things easier.
+	(return-from-frame): Take a sexp not a string.
+	(describe-definition): Describe more types.
+
+	* swank-loader.lisp: Change load order. swank.lisp is now the last
+	file.
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+	swank-gray.lisp, swank-lispworks.lisp, swank-sbcl.lisp,
+	swank-source-path-parser.lisp: Implement changed backend interface
+	and remove references to frontend symbols.
+
+	* swank-backend.lisp (:swank-backend): New package.
+	(definterface): Export the symbol.
+	(:location, :error, :position, :buffer): Define structure of
+	source locations here.
+	(preferred-communication-style, compute-backtrace, print-frame):
+	New functions.
+	(debugger-info-for-emacs): Deleted.
+
+	Renaming:
+
+	compile-file-for-emacs   -> swank-compile-file
+	compile-string-for-emacs -> swank-compile-string
+	compile-system-for-emacs -> swank-compile-stystem
+	arglist-string           -> arglist
+	backrace                 -> compute-backtrace
+	find-function-locations  -> find-definitions
+
+	* swank.lisp (:swank): Create the package here.
+	(*swank-in-background*): Call the backend function
+	preferred-communication-style to for the initial value.
+	(find-symbol-designator): Handle NIL properly.
+	(arglist-string): Renamed from format-arglist.  Call backend
+	function directly.
+	(*sldb-restarts*, swank-debugger-hook, format-restarts-for-emacs)
+	(nth-restart, invoke-nth-restart, sldb-abort): Handle restarts in
+	the front end.
+	(frame-for-emacs): Renamed from print-with-frame-label.
+	(backtrace, debugger-info-for-emacs, pprint-eval-string-in-frame)
+	(set-default-directory): Now in the front end.
+	(frame-locals-for-emacs): Use print not princ for variable names.
+	(compile-file-for-emacs, compile-string-for-emacs): Small wrappers
+	around backend functions.
+	(describe-definition-for-emacs): Handle unknown symbols before
+	calling the backend.
+	(find-function-locations): Wrapper for new backend function
+	find-definitions.
+	(group-xrefs, partition, location-valid-p, xref-buffer, xref):
+	Updated for the new backend functions.
+
+	* slime.el:
+	(slime-symbol-at-point, slime-symbol-name-at-point):
+	slime-symbol-at-point calls slime-symbol-name-at-point not the
+	other way around.  This avoids the mess if the symbol at point is
+	NIL.
+	(slime-compile-file, slime-load-system, slime-compile-region)
+	(slime-call-describer, slime-who-calls, sldb-catch-tags): Updates
+	for renamed lisp functions.
+	(slime-list-callers, slime-list-callees): Unified with other xref
+	commands.
+	(sldb-show-frame-details): Catch tags no longer include the source
+	location.
+	(sldb-insert-locals): Simplified.
+
+2004-03-09  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (read-into-simple-string): Use the correct fix.
+	Reported by Håkon Alstadheim.
+
+2004-03-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-start-swank-server, slime-maybe-start-lisp):
+	Translate filenames.  Reported by Dan Muller.
+
+2004-03-08  Bill Clementson <Bill_Clementson at peoplesoft.com>
+
+	* slime.el (slime-insert-balanced-comments)
+	(slime-remove-balanced-comments, slime-pretty-lambdas): New
+	functions.
+
+2004-03-07  Jouni K Seppanen  <jks at iki.fi>
+
+	* slime.el (sldb-help-summary): New function.
+	(sldb-mode): Add docstring so that describe-mode is useful.
+	(sldb-mode-map): Add bindings for sldb-help-summary and
+	describe-mode.
+	(define-sldb-invoke-restart-key): Generate docstrings.
+	(sldb-default-action/mouse, sldb-default-action)
+	(sldb-eval-in-frame, sldb-pprint-eval-in-frame)
+	(sldb-inspect-in-frame, sldb-down, sldb-up, sldb-details-up)
+	(sldb-details-down, sldb-list-locals, sldb-quit, sldb-continue)
+	(sldb-abort, sldb-invoke-restart, sldb-break-with-default-debugger)
+	(sldb-step): Add rudimentary docstrings.
+
+2004-03-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-complete-symbol*, slime-simple-complete-symbol):
+	Use the correct block name when returning.
+	(slime-display-completion-list): Fix typo.
+
+	* swank-cmucl.lisp (frame-locals): Use #:not-available instead of
+	"<not-available>".
+
+2004-03-05  Bill Clementson <Bill_Clementson at peoplesoft.com>
+
+	* swank-lispworks.lisp (getpid, emacs-connected): Conditionalize
+	for Windows.
+	
+2004-03-05  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (frame-locals-for-emacs): Bind *print-readably* to
+	nil.
+
+2004-03-05  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (frame-locals-for-emacs): New function.
+
+	* slime.el (sldb-frame-locals): Use swank::frame-locals-for-emacs
+	not swank::frame-locals.
+	(sldb-insert-locals): use the :value property, not the
+	:value-string property.
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+	swank-lispworks.lisp, swank-sbcl.lisp (frame-locals): Return lisp
+	objects, not strings. Use the :value property and not the
+	:value-string property.
+
+2004-03-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-display-comletion-list): New function. Set
+	syntax table properly.
+	(slime-complete-symbol*, slime-simple-complete-symbol): Use it.
+	(slime-update-connection-list): New function.
+	(slime-draw-connection-list): Simplified.
+	(slime-connection-list-mode-map): Bind g to update-connection-list.
+	(slime-open-inspector): Print the primitive type in brackets.
+	(slime-test-arglist): Add test for empty arglist.
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+	swank-lispworks.lisp, swank-sbcl.lisp, swank-backend.lisp
+	(thread-alive-p): Add default implementation.
+	(describe-primitive-type): Add default implementation.
+	(inspected-parts): Implemented for Allegro and CLISP.
+
+	* swank.lisp (remove-dead-threads): New function.
+	(lookup-thread): Use it.
+	(print-arglist): New function. This time without a custom pretty
+	print dispatch table.
+	(format-arglist): Use it.
+	(inspected-parts): Add method for hash-tables.
+
+2004-03-03  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp: Use *emacs-connection*, *active-threads*, and
+	*thread-counter* as thread local dynamic variables.
+	(init-emacs-connection): Don't set *emacs-connection*.
+	(create-connection, dispatch-event): Pass the connection object to
+	newly created threads.
+	(with-connection): New macro
+	(handle-request, install-fd-handler, debug-thread): Use it.
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+	swank-openmcl.lisp, swank-sbcl.lisp (call-with-compilation-hooks):
+	Bind fewer variables. Most of them are already bound in
+	swank.lisp.
+
+	* swank.lisp (setup-server, serve-connection): New dont-close
+	argument to keep the socket open after the first connection.
+	(start-server, create-swank-server): Update callers. 
+	Reported by Bill Clementson.
+
+	* swank-cmucl.lisp (resolve-note-location): Don't be too clever,
+	if there is no context available.  The compiler notes buffer is
+	probably more adequate in this situation.
+	(compile-file-for-emacs): Use the :load argument to compile-file.
+	(inspect-in-frame): Deleted.
+
+	* slime.el (slime-compilation-finished-hook): Use
+	slime-maybe-list-compiler-notes as default.
+	(slime-maybe-list-compiler-notes): New function.
+	(slime-list-compiler-notes): Insert "[no notes]" if there aren't
+	any. Pop to the buffer.
+	(slime-complete-symbol*, slime-simple-complete-symbol): Set the
+	lisp-mode-syntax-table in the completion buffer.
+	(check-parens): Compatibility function for XEmacs and Emacs 20.
+
+	* swank.lisp (find-completions): Deleted.
+	(simple-completions): Use longest-common-prefix instead of
+	longest-completion.
+	(inspect-in-frame): Moved here from swank-cmucl.lisp. 
+	
+	* swank-lispworks.lisp (call-with-debugging-environment): Bind
+	*sldb-top-frame*.
+	(nth-frame): Use *sldb-top-frame*.
+	(name-source-location, name-source-locations): Renamed from
+	dspec-source-location, dspec-source-locations.  The result now
+	includes methods for generic functions.
+	(eval-in-frame, return-from-frame, restart-frame): Implemented.
+	(compile-string-for-emacs): Set dspec::*location* to the buffer
+	location.
+	(signal-undefined-functions, signal-error-data-base)
+	(make-dspec-location): Remove temp-file kludges.
+	(patch-source-locations, replace-source-file): Deleted.
+
+2004-03-01  Marco Baringer  <mb at bese.it>
+
+	* swank.lisp (format-arglist): deal with nil arglists.
+
+2004-03-01  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (compile-string-for-emacs): Patch the
+	recorded source locations.
+	(replace-source-file, patch-source-locations): New function.
+	(dspec-buffer-position): Handle defgeneric.
+	(make-dspec-location): Handle (patched) emacs-buffer locations.
+	(emacs-buffer-location-p): New function.
+	(describe-primitive-type, inspected-parts): Implemented.
+	(kill-thread): Implemented.
+
+	* swank-sbcl.lisp, swank-cmucl.lisp, swank-allegro.lisp
+	(kill-thread): Implemented.
+
+2004-02-29  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-complete-symbol): Make slime-complete-symbol
+	customizable.  I don't understand how the ILISP style completion
+	is supposed to work and find it unintuitive.
+	(slime-complete-symbol-function): New variable.
+	(slime-complete-symbol*): Renamed from slime-complete-symbol.
+	(slime-simple-complete-symbol, slime-simple-completions): New
+	function.
+	(slime-compiler-notes-to-tree): Return a list of trees, not a single
+	tree.
+
+	* swank.lisp (format-arglist): Don't use a custom pprint table.
+	Didn't work with CLISP and the behavior was different in SBCL and
+	Lispworks.
+	(completions): Factorize.
+	(parse-completion-arguments, format-completion-set,
+	(completion-set, find-matching-symbols, find-completions): New
+	functions.
+	(simple-completions): New function.
+	(prefix-match-p) New function.
+
+2004-02-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-compilation-finished-hook): New hook variable.
+	(slime-compilation-finished): Call it.
+	(slime-maybe-show-xrefs-for-notes): New function.
+	(slime-make-default-connection): Use the current connection.
+	(slime-connection-at-point): New function.
+	(slime-goto-connection, slime-connection-list-make-default): Use
+	it.
+	(slime-draw-connection-list): Minor cleanups.
+
+	Define selectors for t and c for thread and connection list.
+
+	* swank.lisp: (*initial-pprint-dispatch-table*)
+	(*arglist-pprint-dispatch-table*): Workaround for bug in
+	CLISP. Don't supply nil as argument to copy-pprint-dispatch.
+	(print-cons-argument): Insert a space after the car.
+
+2004-02-27  Marco Baringer  <mb at bese.it>
+
+	* slime.el (slime-read-port-and-connect,
+	slime-read-port-and-connect-to-running-swank): Refactor
+	slime-read-port-and-connect into two functions so that
+	slime-thread-attach can use the logic in
+	slime-read-port-and-connect.
+	(slime-thread-control-mode-map): Added key bindings for
+	slime-thread-kill, slime-thread-attach, slime-thread-debug and
+	slime-list-threads.
+	(slime-thread-kill, slime-thread-attach, slime-thread-debug): New
+	functions.
+
+	* swank-backend.lisp (kill-thread): Added to swank interface.
+
+	* swank-openmcl.lisp (kill-thread): Implement.
+
+	* swank.lisp (start-server): Add optional background argument,
+	defaults to *swank-background*.
+	(lookup-thread-by-id): New function.
+	(debug-thread): New function.
+	
+2004-02-26  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el (slime-draw-connection-list): Use text-properties to
+	associate the connections each line of the connections list
+	buffer.
+
+2004-02-26  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el (slime-list-connections): Make the buffer created by
+	this function do a bit more: Can use it to switch to different
+	connections and change the default.
+
+2004-02-26  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (ccl::force-break-in-listener): Pass a
+	condition object to invoke-debugger.
+	Patch by Bryan O'Connor <bryan-slime at lunch.org>
+
+2004-02-26  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-backend.lisp (:swank): export connection-info.
+
+	* swank-allegro.lisp (lisp-implementation-type-name): Implement
+	it.
+
+	* swank-sbcl.lisp (compile-file-for-emacs): Load the fasl file
+	regardless of f-p.
+
+	* swank.lisp (swank-pprint): Bind *package* to *buffer-package*.
+	Reported by Alan Picard.
+
+	* swank-lispworks.lisp (dspec-buffer-position): Renamed from
+	dspec-buffer-buffer-position.  Handle dspecs of the form (defmacro
+	foo).  Reported by Alan Picard.
+	(arglist-string): Handle unknown arglists properly.
+
+2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (arglist-string): Delay the call to
+	di::function-debug-function until it is actually needed.
+	(compile-file-for-emacs): Load the fasl file irrespective of
+	COMILE-FILE's third return value.
+
+	* swank.lisp (connection-info): New function.
+	(open-streams): Don't send the :check-protocol-version message.  Now
+	handled with CONNECTION-INFO.
+
+	* slime.el (slime-symbol-at-point): Don't skip backwards across
+	whitespace when we are at the first character of a symbol.  To
+	handle this case: skip symbol constituents forward before skipping
+	whitespace backwards.  Reported by Jan Richter.
+	(slime-connection-close-hook, slime-next-connection)
+	(slime-make-default-connection): Remove extra call to format.
+	(slime-init-connection-state): Use only a single RPC instead of 4.
+
+2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-with-chosen-connection): Bind
+	slime-dispatching-connection and not slime-buffer-connection.
+	slime-buffer-connection is a buffer local variable not a dynamic
+	variable.
+	(slime-find-connection-by-type-name)
+	(slime-read-lisp-implementation-type-name): Were lost during the
+	merge.
+	(sldb-fetch-more-frames): Use (goto-char (point-max)) instead of
+	end-of-buffer. 
+
+2004-02-25  Peter Seibel  <peter at javamonkey.com>
+
+	* slime.el: Various bits of support for maintaining multiple SLIME
+	connections to different Lisp implementations simultaneously.
+
+	* swank-backend.lisp (lisp-implementation-type-name): Add function to
+	return simple name of lisp implementation; used by new
+	multi-connection functionality in slime.el.
+
+2004-02-25  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (format-arglist): Use a special pprint-dispatch table.
+
+2004-02-22  Lawrence Mitchell  <wence at gmx.li>
+
+	* swank.lisp (format-arglist): Bind *PRINT-PRETTY* to NIL.
+	(eval-in-emacs): Fix typo in docstring.
+
+	* swank-cmucl.lisp (arglist-string): Bind *PRINT-PRETTY* to NIL.
+	
+2004-02-21  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	Add support for SERVE-EVENT based communication.
+	
+	* swank-sbcl.lisp (add-sigio-handler, remove-sigio-handlers):
+	Renamed.
+	(add-fd-handler, remove-fd-handlers): Implement interface.
+
+	* swank-cmucl.lisp (fcntl): New function.
+	(add-sigio-handler, remove-sigio-handlers): Renamed.
+	(add-fd-handler, remove-fd-handlers): Implement interface.
+
+	* swank.lisp (create-connection): Add support for fd-handlers.
+	(install-fd-handler, deinstall-fd-handler): New functions.
+
+	* swank-backend.lisp (add-sigio-handler): Renamed from
+	add-input-handler.
+	(remove-sigio-handlers): Renamed from remove-input-handlers.
+	(add-fd-handler, remove-fd-handlers): New interface functions.
+
+	* slime.el (slime-batch-test): Use sit-for instead of
+	accept-process-output, so that we see something when swank gets
+	compiled.  May be problematic in real batch mode.
+	(loop-interrupt-continue-interrupt-quit): Wait a second before
+	interrupting.  The signal seems to arrive before the evaluation
+	request if don't wait => the endless loop is executed inside the
+	debugger and sldb-quit will not be processed with fd-handlers.
+
+	* swank.lisp (process-available-input): Move auxiliary function to
+	toplevel.  Test if the stream is open.
+	(install-sigio-handler): Handle the first request after installing
+	the signal handler.
+
+	* slime.el (slime-keys): Bind C-c C-x t to slime-list-threads and
+	C-c C-x c to slime-list-connections.
+	(slime): Disconnect before reconnecting if the inferior-lisp
+	buffer wasn't renamed.
+	(slime-connect): Use the host argument and not "localhost".
+	(slime-compilation-finished): Undo last change.  Switch to the
+	buffer to remove old annotations.
+	(slime-choose-overlay-region): Ignore errors in
+	slime-forward-sexp.
+
+2004-02-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime): Just close the connection when called without
+	prefix-argument.  Keeping the connection open doesn't make sense.
+	We could ask if the Lisp process should be killed, though.
+	(slime-maybe-close-old-connections): Delete unused function.
+	(slime-start-swank-server): Use comint-send-string instead of
+	comint-proc-query, 'cause I don't like Olin "100%" Shivers' code.
+	(slime-init-output-buffer): Show some animations.
+	(slime-repl-clear-output): Fixed.
+	(slime-compilation-finished): It's not necessary to switch to the
+	original buffer, because the buffer is encoded in the
+	source-locations.
+	(sldb-show-source): Don't raise an error if the source cannot be
+	located.  Print a message instead, because errors in
+	process-filters cause a 1 second delay.
+
+	* swank-cmucl.lisp (read-into-simple-string): Workaround for
+	read-sequence bug in 18e.
+
+2004-02-18  Peter Seibel <peter at javamonkey.com>
+
+	* swank-loader.lisp: Place the fasl files of different
+	implementations in different directories.
+
+2004-02-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-clisp.lisp: Update comments about metering package.
+
+	* metering.lisp: Imported from CLOCC.  Suggested by Peter Seibel.
+
+2004-02-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp, slime.el (make-compiler-note): Don't send the
+	short-message across the wire if the slot is nil.
+
+	* swank-cmucl.lisp (clear-xref-info): Compare the truenames with
+	equalp instead of the unix-truenames.  The old version was very
+	inefficient (clearing the tables with about 1000 entries required
+	serveral seconds).
+	(xref-context-derived-from-p, pathname=): Delete unused functions.
+
+	* swank-clisp.lisp (remove-input-handlers):
+	socket:socket-stream-handle is not available on Windows.
+	Reported by Alan Shutko.
+
+	* slime.el (slime-length>): New function.
+	(slime-compiler-notes-to-tree): Don't collapse if there is only
+	one kind of notes.
+
+2004-02-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (make-compiler-note): Include short-message.
+
+	* swank-sbcl.lisp (signal-compiler-condition): Initialize
+	short-message slot.
+	(long-compiler-message-for-emacs): New function.
+
+	* swank-cmucl.lisp (handle-notification-condition): Don't use the
+	context of the previous message.
+	(signal-compiler-condition): Set short message slot.
+	(long-compiler-message-for-emacs): New function.
+	(sigio-handler): Ignore arguments.
+
+	* swank-clisp.lisp (set-sigio-handler, add-input-handler):
+	Conditionalize for linux.
+
+	* swank-backend.lisp (compile-system-for-emacs): Add default
+	implementation.
+	(compiler-condition): New slot short-message.
+
+	* slime.el (slime-compilation-finished): Display compiler notes
+	grouped by severity in a separate buffer.
+	(slime-compilation-finished-continuation, slime-compile-file)
+	(slime-load-system, slime-compile-string): Update callers.
+	(slime-list-compiler-notes, slime-alistify, slime-tree-for-note)
+	(slime-tree-for-severity, slime-compiler-notes-to-tree)
+	(slime-compiler-notes-mode, slime-compiler-notes-quit): New
+	functions.
+	(with-struct, slime-tree): New code for pseudo tree widget.
+	(slime-init-connection-state): Set slime-state-name to "".
+
+2004-02-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (create-socket): Fix last fix.  Use the proper
+	port argument.
+
+	* swank-allegro.lisp, swank-backend.lisp, swank-clisp.lisp,
+	swank-cmucl.lisp, swank-lispworks.lisp, swank-openmcl.lisp,
+	swank-sbcl.lisp (create-socket): Take interface as argument.
+	
+	* slime.el (sldb-show-frame-details): Fix typos.
+	(slime-print-apropos): Don't bind action.
+	(slime-reset): Kill sldb-buffers.
+	(slime-test-find-definition, slime-test-complete-symbol)
+	(slime-test-arglist): Add more slime-check-top-level calls.
+
+	* swank.lisp (setup-server): Pass loopback-interface to
+	create-socket.  Reported by Dirk Gerrits.
+	(*loopback-interface*): New parameter.
+	(sldb-loop): Send :debug event inside unwind-protect, so we never
+	lose the corresponding :debug-return event.
+
+2004-02-08  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp (find-source-locations): Eliminate unused
+	variable warning.
+
+	* swank.lisp (swank-pprint): Bind pretty print vars to
+	*swank-pprint-X* counter parts.
+	(*swank-pprint-circle*, *swank-pprint-escape*,
+	*swank-pprint-level*, *swank-pprint-length*): Swank counterparts
+	to *print-X* variables used when swank needs to pretty print a
+	form.
+	(apply-macro-expander): Use swank-pprint.
+
+2004-02-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (send, receive, interrupt-thread): Implement
+	more threading functions.
+
+	* swank-sbcl.lisp (inspected-parts): Implemented.
+
+	* slime.el (slime-rex): Mention thread argument in docstring.
+	(sldb-break-with-default-debugger): Use slime-rex and don't switch
+	to the output buffer (happens automatically).
+	(slime-list-threads): Renamed from slime-thread-control-panel.
+	(slime-thread-insert): Use slightly different layout.
+	(slime-give-goahead, slime-waiting-threads)
+	(slime-popup-thread-control-panel, slime-register-waiting-thread)
+	(slime-thread-goahead): Deleted.
+	(slime-maybe-start-multiprocessing): Call
+	swank:startup-multiprocessing.  Reported by Paolo Amoroso.
+
+	* swank.lisp (dispatch-event): :debug, :debug-condition,
+	:debug-activate events were all encoded as :debug events, which
+	means the debugger never worked!  Fix it.  I guess no one uses
+	SLIME with a multithreaded Lisp.
+	(read-user-input-from-emacs): Flush the output before reading.
+	(sldb-loop): Add a sldb-enter-default-debugger tag, so we can
+	enter the default debugger by throwing to it.
+	(sldb-break-with-default-debugger): Throw to
+	sldb-enter-default-debugger.
+	(*thread-list*): New variable.
+	(list-threads): New function.
+
+	* swank-backend.lisp (thread-name): Take a thread object as
+	argument.
+	(thread-status, all-threads, thread-alive-p): New function.
+	(thread-id): Deleted.
+
+	* swank-allegro.lisp, swank-cmucl.lisp, swank-lispworks.lisp,
+	swank-openmcl.lisp, swank-sbcl.lisp: Update for modified thread
+	interface.
+
+	* swank-sbcl.lisp (enable-sigio-on-fd): New function.  Use
+	fallback if sb-posix:fcntl isn't fbound.
+
+	* swank-cmucl.lisp (gf-definition-location): Return an error when
+	pathname for the GF is nil (this happens if the GF is not compiled
+	from a file).
+
+	* swank.lisp (undefine-function): New function.
+	(print-with-frame-label, print-part-to-string): Bind
+	*print-circle* to t, to avoid unbound recursion when printing
+	cyclic data structures.
+
+	* slime.el (slime-undefine-function): New command.  Bound to C-c
+	C-u.
+
+2004-02-06  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (sldb-setup): Offer to enter a recursive edit if there
+	are pending continuations.  
+	(slime-eval): Unwind the stack, thereby exititing recursive edits,
+	before signaling the error.
+
+2004-02-05  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-openmcl.lisp (compile-system-for-emacs): Remove compile
+	time dependency on ASDF.
+
+2004-02-05  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp, swank-loader.lisp: Add profiling support via
+	Kantrowitz's metering package.  Reporting needs to be
+	refined (profile-package currently ignores callers-p and methods).
+
+2004-02-04  Bryan O'Connor <bryan-slime at lunch.org>
+
+	* swank-openmcl.lisp (mailbox): Use a semaphore instead of
+	process-wait.  Works better with native threads.
+
+2004-02-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-backend.lisp (debugger-info-for-emacs): Export it.
+
+	* swank-sbcl.lisp (add-input-handler): Use fcntl from the sb-posix
+	package.
+	
+	* swank.lisp (sldb-loop, dispatch-event, send-to-socket-io): Send
+	a :debug-activate event instead of a :debug event (to avoid
+	sending a potentially long backtrace each time).
+	(handle-sldb-condition): Include the thread-id in the message.
+
+	* slime.el (slime-path): Use load-file-name as fallback.
+	Suggested by Lawrence Mitchell.
+	(slime-dispatch-event): Add support for :debug-activate event.
+	(sldb-activate): New function.
+	(sldb-mode): make-local-hook doesn't seem to work in Emacs 20.
+	Use a buffer local variable instead.
+	(slime-list-connections): Don't print Lisp's state.
+	(slime-short-state-name): Deleted.
+	
+2004-02-02  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-debugger): The customization group is called
+	'slime-debugger', fix referrers.  Reported by Jouni K Seppanen.
+
+	* swank.lisp (simple-break): Bind *debugger-hook* before invoking
+	the debugger.  Reported by Michael Livshin.
+
+2004-01-31  Robert E. Brown <bbrown at speakeasy.net>
+
+	* swank-sbcl.lisp, swank.lisp: Add more type declarations and
+	detect missing initargs for the connection struct.  
+
+2004-01-31  Jouni K Seppanen <jks at iki.fi>
+
+	* slime.el (slime-path): Placed inside an eval-and-compile.  Works
+	around some problems when byte-compiling slime-changelog-date.
+
+2004-01-31  Marco Baringer  <mb at bese.it>
+
+	* swank-openmcl.lisp: remove defslimefun-unimplemented forms.
+	(call-with-compilation-hooks, compile-system-for-emacs): Implement
+	them.
+	(compile-file-for-emacs, compile-string-for-emacs): Use
+	with-compilation-hooks.
+	(list-callers): Define with defimplementation and not defslimefun.
+
+	* swank-backend.lisp (compile-system-for-emacs): Declare method
+	as part of the interface.
+
+	* slime.el (slime-find-asd): Handle files whose directory does
+	not contain an asdf system definition.
+	
+2004-01-31 Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	Merge stateless-emacs branch into main trunk.  We use now signal
+	driven IO for CMUCL and one thread per request for multithreaded
+	Lisps.
+
+2004-01-31  Robert E. Brown <bbrown at speakeasy.net>
+
+	* swank-backend.lisp, swank-sbcl.lisp,
+	swank-source-path-parser.lisp, swank.lisp: Add type declarations
+	to keep SBCL quiet.
+
+2004-01-29  Michael Weber <michaelw+slime at foldr.org>
+
+	* slime.el, swank-backend.lisp, swank-cmucl.lisp, swank-sbcl.lisp,
+	swank.lisp: Profiler support.
+
+2004-01-23  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* swank-openmcl.lisp: Bind ccl::*signal-printing-errors* to nil
+	inside debugger so that error while printing error take us down.
+	
+2004-01-23  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-sbcl.lisp (eval-in-frame, return-from-frame): Implemented.
+	(sb-debug-catch-tag-p): New auxiliary predicate.
+	(source-path<): Delete unused function.
+
+2004-01-23  Michael Weber  <michaelw at foldr.org>
+
+	* slime.el (slime-keys): Bind C-c M-p to slime-repl-set-package.
+	(slime-easy-menu): Add entry for slime-repl-set-package.
+	
+2004-01-23  Michael Weber  <michaelw at foldr.org>
+
+	* slime.el (slime-repl-set-package): New command to set the
+	package in the REPL buffer.
+
+	* swank.lisp (set-package): Return the shortest nickname.
+
+2004-01-23  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (sldb-disassemble): Was lost somewhere.
+	
+2004-01-22  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp: Replace defmethod by defimplementation where
+	appropriate.
+	(return-from-frame, restart-frame): Implement them.
+	
+2004-01-22  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* test.sh: Copy the ChangeLog file too.
+
+	* swank-cmucl.lisp: Replace some defmethods with
+	defimplementation.
+
+	* swank-allegro.lisp (return-from-frame, restart-name): Implement
+	interface (partly).
+
+	* swank-openmcl.lisp (restart-frame, return-from-frame): Remove
+	sldb-prefix.
+
+	* swank-backend.lisp (return-from-frame, restart-frame):
+	Are now interface functions.
+
+	* swank.asd: Remove dependency on :sb-bsd-sockets.  Is already
+	done in swank-sbcl.
+
+	* swank-loader.lisp: Don't reference the swank package at
+	read-time.
+
+	* swank.lisp (completions): Never bind *package* to nil.  That's a
+	type error in SBCL.
+	(swank-debugger-hook): Flush the output streams and be careful
+	when accessing *buffer-package*.  
+	(create-swank-server): Return the port of the serve socket.
+
+	* swank-lispworks.lisp (interesting-frame-p): Don't print catch
+	frames.
+	(make-sigint-handler): New function.
+	(emacs-connected): Use it.
+
+	* slime.el (slime-lisp-implementation-type): New per connection
+	variable.
+	(slime-handle-oob): Handle debug-condition event.  Can be signaled
+	CMUCL when cannot produce a backtrace.
+	(slime-debugging-state): Don't pop up the debugger buffer an
+	activate events. Annoying.
+	(sldb-break-with-default-debugger): Switch to the output buffer
+	before returning to the tty-debugger.
+	(sldb-return-from-frame, sldb-restart-frame): Use slime-rex.
+	(slime-list-connections, slime-short-state-name): New functions.
+
+2004-01-20  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-complete-symbol): Insert the completed-prefix
+	before deleting the original text to avoid troubles with left
+	inserting markers.
+	(slime-symbol-start-pos): Skip backward across symbol
+	constituents.
+	(slime-evaluating-state): [:read-sring] Save the window
+	configuration.
+	(slime-read-string-state): Don't handle activate events
+	(troublesome if, e.g, complete-symbol is used from another
+	buffer).  Restore the window configuration.
+	(slime-repl-read-string): Goto the end of buffer.
+	(slime-debugging-state): [:activate] Display the debugger buffer
+	if not visible.
+	(slime-to-lisp-filename, slime-from-lisp-filename)
+	(slime-translate-to-lisp-filename-function)
+	(slime-translate-from-lisp-filename-function, slime-compile-file)
+	(slime-goto-location-buffer, slime-ed, slime-load-file): Support
+	for remote filename translation (untested).
+
+	* swank.lisp (create-swank-server): Take announce-fn as optional
+	argument.
+
+	* swank-allegro.lisp: Replace defmethod with defimplementation.
+	(eval-in-frame): Implemented.
+
+2004-01-20  Lasse Rasinen  <lrasinen at iki.fi>
+
+	* slime.el (slime-prin1-to-string): Replacement for
+	prin1-to-string that avoids escaping non-ascii characters in a
+	way that the CL reader doesn't understand. Allows use of 8-bit
+	characters in Lisp expressions with Emacs in unibyte-mode.
+
+2004-01-20  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-eval-print-last-expression): Insert a newline
+	before and after the result.
+	(slime-easy-menu): Added menu items:
+	"Eval Region", "Scratch Buffer", "Apropos Package..."
+	Added some bold to default SLDB faces.
+
+2004-01-19  Alan Ruttenberg  <alanr-l at mumble.net>
+        *swank-openmcl.lisp in frame-catch-tags, ppc32::catch-frame.catch-tag-cell -> 0,
+	ppc32::catch-frame.csp-cell -> 3. FIXME when this code is more stable in openMCL.
+	
+2004-01-19  Michael Weber  <michaelw at foldr.org>
+
+	* slime.el (slime-close-all-sexp): New command to close all
+	unmatched parens in the current defun. Bound to `C-c C-]'. With
+	prefix argument, only operate in the region (for closing
+	subforms).
+
+2004-01-19  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-openmcl.lisp (thread-id, thread-name): Fixed silly bugs
+	(thanks Marco Baringer).
+
+	* swank-loader.lisp: Call (swank:warn-unimplemented-interfaces).
+
+	* swank.lisp (ed-in-emacs): New command with the same interface
+	as CL:ED.
+
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-lispworks.lisp,
+	swank-openmcl.lisp, swank-allegro.lisp, swank-clisp.lisp: Updated
+	to use `defimplementation'.
+
+	* swank-backend.lisp (definterface, defimplementation): New macros
+	as sugar around defgeneric/defmethod. This supports conveniently
+	supplying a default (on NO-APPLICABLE-METHOD).  Because the
+	underly mechanism is still generic functions this doesn't break
+	code that isn't updated.
+	(warn-unimplemented-interfaces): Print a list of backend functions
+	that are not implemented.
+	(xref and list-callers): Defined interfaces for these functions.
+	(describe-definition): New function that takes over from the many
+	other describe-* functions called from apropos listing. Takes the
+	type of definition (as returned by describe-symbol-for-emacs) as
+	an argument.
+
+	* slime.el (sldb-enable-styled-backtrace): This is now true by
+	default.
+	(slime-keys): Bound `slime-inspect' to `C-c I'.
+	(slime): `M-x slime' now offers to keep existing connections
+	alive (else disconnect them). If you disconnect them, the new
+	connection gets to reuse the existing REPL.
+	(slime-connection): Error if the connection is closed.
+	(slime-handle-oob): New message (:ED WHAT) for `slime-ed'.
+	(slime-display-output-buffer): Don't pop up the REPL if it is
+	already visible in any frame.
+	(slime-find-asd): Handle case where (buffer-file-name) is nil.
+	(slime-ed): Elisp backend for (CL:ED WHAT).
+	(slime-apropos): Add a summary line to apropos listings.
+	(slime-print-apropos): Replaced `action' property (name of lisp
+	describe function) with `type' (argument to pass to unified
+	swank:describe-definition function).
+	(slime-apropos-package): New command on `C-c P'. Presents apropos
+	listing for all external (with prefix also internal) symbols in a
+	package.
+
+2004-01-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (sigint-handler): Bind a continue restart.
+	(make-dspec-location): Handle strings like pathnames.
+	Some multithreading support.
+
+	* slime.el (compile-defun): Don't use keywords.  The keyword
+	package is locked in Lispworks and causes the test-suite to hang.
+	(slime-eval-with-transcript): Fix bug triggered when 'package' is
+	a buffer local variable.  Reported by Janis Dzerins.
+	(slime-batch-test): Wait until the connection is ready.
+
+2004-01-18 Alan Ruttenberg  <alanr-l at mumble.net>
+
+	* swank-openmcl: Implement frame-catch-tags. Added debugger functions 
+	sldb-restart-frame, sldb-return-from-frame. Should probably be added to backend.lisp
+	but let's discuss first. Do other lisps support this?
+	
+	* slime.el sldb-restart-frame, sldb-return-from-frame
+
+2004-01-18  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp (call-without-interrupts): Evaluate
+	linux:SIGFOO at read time since the macro with-blocked-signals
+	expects a fixnum.
+	(compile-file-for-emacs): Comment fix.
+
+2004-01-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-sbcl.lisp (make-fn-streams): Deleted.  Already defined in
+	swank-gray.lisp.
+
+	* swank.lisp (find-symbol-or-lose, format-arglist): New functions.
+	(without-interrupts): New macro.
+	(send-to-emacs): Use it.
+
+	* swank-backend.lisp, swank-clisp.lisp, swank-lispworks.lisp,
+	swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp:
+	(arglist-string): Refactor common code to swank.lisp.
+	(call-without-interrupts, getpid): Are now generic functions.
+
+	* slime.el (arglist): Test slot readers and closures.
+
+	* swank-cmucl.lisp (arglist-string): Use
+	pcl:generic-function-lambda-list for generic functions.  Handle
+	closures.  Print arglist in lower case.
+	(inspected-parts-of-value-cell): Was lost during the inspector
+	refactoring.
+
+2004-01-18  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp (compile-file-for-emacs,
+	split-compiler-note-line): Revert last change.
+	(handle-notification-condition): Don't signal the condition.
+	(*compiler-note-line-regexp*): Fix and rewrite it as extended
+	regexp.
+
+	* slime.el (slime-changelog-date): Use file-truename of
+	byte-compile-current-file.
+	
+2004-01-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-format-arglist): Add some sanity checks and
+	print zero argument functions nicer.  Suggested by Ivan Boldyrev.
+	(slime-test-expect): Take test predicate as argument.
+	(arglist): Test generic functions.
+
+	* swank-cmucl.lisp (arglist-string): Handle generic functions
+	better.  Reported by Ivan Boldyrev.
+
+2004-01-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp: Multiprocessing support.
+
+	* swank-openmcl.lisp, swank-cmucl.lisp, swank-backend.lisp,
+	swank.lisp: Refactor inspector code.
+	
+	* swank.lisp (changelog-date): Use *compile-file-truename* instead
+	of *compile-file-pathname*.
+	(with-I/O-lock, with-a-connection): The usual CLISP fixes.
+	(create-swank-server): Patch by Marco Baringer <mb at bese.it>.
+	Bring it back again.
+	(create-connection): Use return the dedicated output stream if
+	available.
+
+	* slime.el: Numerous REPL related fixes.
+	(slime-update-state-name): Take state as argument.
+	(slime-repl-beginning-of-defun, slime-repl-end-of-defun): Fix
+	typos.
+	(sldb-insert-restarts): Remove duplicate definition.
+
+2004-01-16  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-openmcl.lisp: Multiprocessing support.
+
+	* swank.lisp (changelog-date): make-pathname portability fix
+	(from alanr).
+	(with-io-redirection): Use (current-connection) instead of
+	*dispatching-connection* (from alanr).
+
+	* slime.el (slime-init-output-buffer): XEmacs portability fix, and
+	use header-line-format to show info about Lisp in Emacs21.
+
+2004-01-15  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-sbcl.lisp, swank-cmucl.lisp (remove-input-handlers): New
+	method.
+
+	* swank-allegro.lisp (excl:stream-read-char-no-hang): Import it.
+	(emacs-connected): Add default method.  The method for
+	no-applicable-method doesn't seem to work.  ACL bug?
+
+	* swank-loader.lisp (compile-files-if-needed-serially): Don't
+	handle compilation errors.  We must compile everything because
+	changelog-date requires *compile-file-truename*.
+
+	* slime.el: (slime-changelog-date)
+	(slime-check-protocol-version): New functions.
+	(slime-handle-oob): Handle :check-protocol-version event.
+	(slime-init-output-buffer): Print some info about the remote Lisp.
+	(slime-connect): Use it.
+	(slime-note-transcript-start): Renamed from
+	slime-insert-transcript-delimiter.
+	(slime-note-transcript-end): New function.
+	(slime-with-output-end-mark, slime-repl-insert-prompt)
+	(slime-repl-show-result, slime-compile-file)
+	(slime-show-evaluation-result): Insert output from eval commands
+	after the prompt and asynchronous output before the prompt.  Needs
+	documentation.
+	(repl-test, repl-read, interactive-eval-output): New tests.
+	(slime-flush-output): Accept output from all processes.
+
+	* swank.lisp (serve-requests): New function.
+	(setup-server): Use it.
+	(start-server): Pass backgroud to setup-server.
+	(create-connection): Check the protocol version.
+	(changelog-date): New function.
+	(make-output-function): Use write-string instead of princ.
+
+	* swank-backend.lisp (remove-input-handlers): New function.
+
+2004-01-15  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-aux-connect, slime-handle-oob): Support for
+	(:open-aux-connection port) message where Lisp requests that
+	Emacs make a connection. These are "auxiliary" connections which
+	don't (or at least shouldn't) have their own REPL etc.
+
+	* swank.lisp: New support for multiprocessing and multiple
+	connections + commentary.
+	(with-a-connection): Macro to execute some forms "with a
+	connection". This is used in the debugger hook to automatically
+	create a temporary connection if needed (i.e. if the current
+	thread doesn't already have one).
+	(open-aux-connection): Helper function to create an extra
+	connection to Emacs.
+
+	* swank-sbcl.lisp: Implemented multiprocessing. Not perfect.
+
+	* swank-cmucl.lisp: Implemented new multiprocessing interface.
+	(create-socket): Make FDs non-blocking when multiprocessing is
+	enabled.
+	(startup-multiprocessing): Set *swank-in-background* to :spawn.
+
+	* swank-backend.lisp: Changed multiprocessing interface.
+
+2004-01-15  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp (with-blocked-signals): New macro.
+	(without-interrupts): Use it.
+	(*use-dedicated-output-stream*, *redirect-output*): Don't set them
+	here, use the default settings.
+	Make :linux one of *features* if we find the "LINUX" package.
+
+2004-01-14  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-openmcl.lisp (emacs-connected): Typo fix (missing
+	close-paren).
+
+2004-01-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-input-complete-p): Tolerate extra close parens.
+	(slime-idle-state): Don't active the repl.
+	(slime-insert-transcript-delimiter): Insert output before prompt.
+	(slime-open-stream-to-lisp): Initialize the process-buffer with
+	the connection buffer.
+	(slime-repl-activate): Deleted.
+	(slime-repl-eval-string, slime-repl-show-result)
+	(slime-repl-show-abort): Better handling of abortion.
+	(slime-compile-file): Insert output before prompt.
+
+	* swank-lispworks.lisp (create-socket): Fix condition message.
+
+	* swank-openmcl.lisp (*swank-in-background*): Set to :spawn.
+	(emacs-connected): Initialize ccl::*interactive-abort-process*.
+
+	* swank.lisp (*swank-in-background*): New variable.
+	(start-server): Start swank in background, depending on
+	*swank-in-background*.
+
+	* swank-cmucl.lisp, swank-sbcl.lisp (*swank-in-background*): Set
+	to :fd-handler.
+	
+	* swank-clisp.lisp (accept-connection): Remove superfluous call to
+	socket-wait.
+
+	New more direct socket interface.  The new interface is closer to
+	the functions provided by the implementations.  For Lispworks we
+	use some non-exported functions to get a sane interface.  The
+	interface also includes add-input-handler and a spawn function
+	(not used yet).  The idea is that most of the logic can be shared
+	between similar backends.
+
+	* swank-gray.lisp (make-fn-streams): New function.
+	(stream-read-char-no-hang, stream-read-char-will-hang-p): Moved to
+	here from swank-clisp.lisp.
+
+	* swank-allegro.lisp, swank-clisp.lisp, swank-cmucl.lisp,
+	swank-lispworks.lisp, swank-openmcl.lisp, swank-sbcl.lisp:
+	(create-socket, local-port, close-socket, accept-connection)
+	(add-input-handler, spawn): Implement new socket interface.
+
+	* swank.lisp (start-server, open-dedicated-output-stream &etc):
+	Use new socket functions.
+
+	* swank-backend.lisp (create-socket, local-port, close-socket)
+	(accept-connection, add-input-handler, spawn): New functions.
+	(accept-socket/stream, accept-socket/run): Deleted.
+
+2004-01-13  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-clisp.lisp: Updated for new network interface but not
+	tested! Probably slightly broken.
+
+	* swank-lispworks.lisp: Updated for new network interface.
+	(accept-socket/stream): This function is currently broken, so
+	LispWorks can't use the dedicated output channel at the moment.
+
+	* swank.lisp, swank-cmucl.lisp, swank-sbcl.lisp: Updated for new
+	network interface.
+
+	* swank-backend.lisp (accept-socket/stream, accept-socket/run):
+	New functions replacing the ancient (over 24 hours!)
+	`create-socket-server'. This interface is much simpler.
+
+2004-01-12  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-lispworks.lisp: Partially updated for new backend
+	interface, but not actually working. The sockets code is broken, I
+	haven't grokked LispWorks the interface properly.
+
+	* swank-gray.lisp (slime-input-stream, slime-output-buffer): Added
+	slots to support the new `make-fn-streams' interface from
+	swank-backend.lisp. These slots need to be initialized by the
+	backend, see swank-sbcl.lisp for an example (very easy).
+
+	* swank-sbcl.lisp (create-socket-server): Implemented new server
+	interface.
+
+	* slime.el (slime-handle-oob): Added
+	:open-dedicated-output-stream message, previously implemented
+	with :%apply.
+	(slime-repl-read-string, slime-repl-return-string): Pass integer
+	argument to `slime-repl-read-mode' to set rather than toggle.
+
+	* swank.lisp: Taking over previously non-portable jobs:
+	(start-server): Now only uses sockets code from the backend.
+	(handle-request): Top-level request loop.
+	(open-dedicated-output-stream): Dedicated output socket.
+	(connection): New data structure that bundles together the things
+	that constitute a connection to Emacs: socket-level stream and
+	user-level redirected streams.
+
+	* swank-cmucl.lisp (create-socket-server): Generic TCP server
+	driven by SERVE-EVENT.
+	(serve-one-request, open-stream-to-emacs): Deleted. Now handled
+	portably in swank.lisp.
+	(make-fn-streams): Implement new stream-redirection interface.
+	(slime-input-stream): New slot referencing output sibling, so it
+	can be forced before input requests.
+
+	* swank-backend.lisp (create-socket-server): Generic
+	callback-driven TCP server interface. Replaces
+	`create-swank-server', with the higher-level logic moved into
+	swank.lisp.
+	(emacs-connected): Invoked when Emacs initially connects, as a
+	hook for backend implementations.
+	(make-fn-streams): Interface for creating pairs of input/output
+	streams that are backended by callback functions. Used to
+	implement redirected-via-Emacs standard I/O streams.
+
+2004-01-12  Lawrence Mitchell  <wence at gmx.li>
+
+	* slime.el (slime-events-buffer): Set `hs-block-start-regexp'
+	before running `hs-minor-mode'.
+
+2004-01-10  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (package-updating): Expected package is now a list (can
+	be any), since the shortest nickname is not
+	standardized. e.g. USER or CL-USER for COMMON-LISP-USER.
+
+	* swank-cmucl.lisp: Don't enable xref (let the user decide).
+	(set-fd-non-blocking): Removed unused function.
+	Miscellaneous refactoring of the networking code.
+
+	* slime.el (slime-complete-symbol): Use markers to hold the
+	beginning and end of the completion prefix, in case looking up
+	completions causes insertions (e.g. GC announcements).
+
+2004-01-09  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-activate-state): Only update state name when
+	`slime-default-connection' activates. This fixes an annoying
+	"Selecting deleted buffer" bug that prevented SLIME from being
+	restarted.
+	(slime-next-connection): Fixed a bug where buffer-local connection
+	bindings could get in the way and prevent the connection from
+	actually changing.
+	(slime-complete-restore-window-configuration): Wrap
+	`set-window-configuration' in `save-excursion'. This fixes a
+	problem where the cursor would end up in the wrong place after
+	completion in XEmacs.
+
+2004-01-09  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Place (require 'cl) inside a eval-and-compile.
+	(slime-with-connection-buffer): Move definition upwards before the
+	first use.
+	(package-updateing): New test for package updates in the listeners.
+
+	* swank.lisp (eval-region): Bind *package* outside the
+	unwind-protect to detect updates.
+
+	* swank-backend.lisp (debugger-info-for-emacs)
+	(find-function-locations): Doc fix.
+
+2004-01-09  Wolfgang Jenkner  <wjenkner at inode.at>
+
+	* swank-clisp.lisp: Add methods for GRAY:STREAM-READ-CHAR-NO-HANG
+	and for the CLISP specific GRAY:STREAM-READ-CHAR-WILL-HANG-P.
+	This should fix the behaviour of SYS::READ-FORM.
+
+2004-01-08  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-inspector-fontify): Function to insert a string
+	in a particular inspector face. Replaces macro-code-generation
+	function `slime-inspector-expand-fontify'. Fixes a byte-compile
+	problem (macro was calling function not defined at compile-time).
+
+2004-01-07  Luke Gorrie  <luke at bluetail.com>
+	
+	* slime.el: Multisession internal improvements. Now there are
+	three separate connection variables, in order of priority:
+	  slime-dispatching-connection (dynamically-bound)
+	  slime-buffer-connection      (buffer-local)
+	  slime-default-connection     (global)
+	The most specific one available is used. This is splitting
+	`slime-connection' into multiple variables, so that you can be
+	specific about what you want to assign (i.e. know if you're
+	setting a dynamic binding or a buffer-local one).
+	Fixed some related bugs.
+	(slime-connection-close-hook): If default connection closes,
+	select another connection.
+	(slime-lisp-package): Initially CL-USER nickname instead of
+	COMMON-LISP-USER (for REPL prompt).
+
+	* slime.el (slime): Multisession support: with prefix argument,
+	gives the option of keeping existing sessions and firing up an
+	additional *inferior-lisp* to connect to. Each connection now has
+	its own *slime-repl[<n>]* buffer.
+	(slime-connection): Should now be read via the function of the
+	same name. The accessor will check if the value is NIL, and if so
+	use `slime-default-connection'.
+	(slime-default-connection): The connection that will be used by
+	default, i.e. unless `slime-connection' is bound. Renamed from
+	`slime-primary-connection'.
+	(slime-init-connection-state): When reconnecting, update the
+	`slime-connection' binding in the REPL to use the new connection.
+	(slime-repl-input-history, ...): REPL variables are now
+	buffer-local.
+
+2004-01-06  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (eval-string): New argument 'id'.  Used to identify
+	the remote continuation.
+	(log-event): New debugging function.
+	(read-from-emacs, send-to-emacs): Use it.
+
+	* slime.el: The new macro 'slime-rex' can now be used to evaluate
+	sexps remotely.  It offers finer control what to do when the
+	evaluation aborts.
+	(slime-rex): New macro
+	(slime-eval, slime-eval-async, sldb-continue)
+	(sldb-invoke-restart): Use it.
+	(slime-continuation-counter, slime-push-evaluating-state): New
+	functions.
+	(slime-output-buffer): Initialize markers.
+	(sldb-mode): XEmacs doesn't like (add-hook (make-local-hook ...)).
+	(slime-init-connection): New optional argument SELECT.
+	(slime-def-connection-var): Workarounds for Emacs 20 reader bugs.
+	Backquote is pretty broken Emacs 20.
+	
+2004-01-06  Ignas Mikalajunas <i.mikalajunas at mbt.lt>
+
+	* swank-loader.lisp (user-init-file): Use merge-pathames.  Fix
+	Windows support.
+
+2004-01-05  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Multiple session support, i.e. Emacs can open
+	multiple connections to Lisps. The guts is there, but
+	user-interface is currently minimal.
+	(slime-net-process): Replaced with slime-net-processes.
+	(slime-net-send): Take process as argument.
+	(slime-process-available-input): Poll all connections.
+	(slime-connection): Current connection (process) to use for
+	talking to Lisp. Can be bound dynamically or buffer-local.
+	(slime-with-connection-buffer): Macro to enter the process-buffer
+	of `slime-connection' to manipulate the local variables.
+	(slime-stack-stack): Now buffer-local in the process-buffer of
+	each connection.
+	(slime-push-state, slime-pop-state): Operate on the stack inside
+	`slime-connection's process-buffer.
+	(slime-dispatch-event): Take optional process argument, to bind
+	`slime-connection' appropriately when events arrive from the
+	network.
+	(slime-def-connection-var): Macro to define variables that are
+	"connection-local". Such variables are used via (setf'able)
+	accessor functions, and their real bindings exist as local
+	variables in the process-buffers of connections. The accessors
+	automatically work on `slime-connection'.
+	(slime-lisp-features, slime-lisp-package, slime-pid, sldb-level):
+	These variables are now connection-local.
+	(slime-read-from-minibuffer): Inherit `slime-connection' as
+	buffer-local so that we complete towards the right Lisp.
+	(sldb-mode): Inherit `slime-connection' as buffer-local so that we
+	debug towards the right Lisp.
+	(get-sldb-buffer): New function to return (optionally create) the
+	SLDB buffer for the current connection. Since multiple Lisps can
+	be debugged simultaneously, the buffername now includes the
+	connection number.
+	(slime-connection-abort): New command to abort a connection
+	attempt (don't use `slime-disconnect' anymore - that closes all
+	connections).
+	(slime-execute-tests): Honor `slime-test-debug-on-error'.
+	(slime-next-connection): Cycle through open Lisp connections.
+
+2004-01-02  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-display-output-buffer): Move the output markers
+	to the end of the buffer.
+
+	* swank-clisp.lisp (frame-do-venv): Rename the :symbol property to
+	:name.
+	(format-condition-for-emacs): Replaced with
+	debugger-condition-for-emacs.
+	(backtrace): Use print-with-frame-label.
+	
+	* swank-openmcl.lisp (format-condition-for-emacs): Replaced with
+	debugger-condition-for-emacs.
+	(backtrace): Use print-with-frame-label.
+	(frame-locals): Rename the :symbol property to :name.
+
+	* swank-lispworks.lisp (format-condition-for-emacs): Replaced with
+	debugger-condition-for-emacs.
+	(backtrace): Use print-with-frame-label.
+	(frame-locals): Rename the :symbol property to :name.
+
+	* swank-allegro.lisp (frame-locals): Rename the :symbol property
+	to :name.
+	(format-condition-for-emacs): Replaced with
+	debugger-condition-for-emacs.
+	(backtrace): Use print-with-frame-label.
+
+	* swank-sbcl.lisp (tracedp, toggle-trace-fdefinition)
+	(format-condition-for-emacs): Remove unused functions.
+	(format-frame-for-emacs): Use print-with-frame-label.
+	(compute-backtrace): Simplified.
+	(backtrace): Return our frame numbers.
+	(frame-locals): Rename the :symbol property to :name.  Remove the
+	:validity property.
+	
+	* swank-cmucl.lisp (accept-loop, safe-definition-finding): Doc
+	fix.
+	(location-buffer=, file-xrefs-for-emacs)
+	(sort-contexts-by-source-path, source-path<)
+	(format-condition-for-emacs): Remove unused functions.
+	(format-frame-for-emacs): Don't include the frame number in the
+	description, but use the frame number for indentation. Update
+	callers.
+	(frame-locals): Rename the :symbol property to :name.
+	
+	* slime.el (slime-add-face): New function.
+	(sldb-add-face): Use it.
+	(sldb-setup): Some refactoring.
+	(sldb-insert-condition): New function.  Factorized from
+	sldb-setup.  Message and types are now separate.
+	(sldb-insert-restarts): New function.  Factorized from sldb-setup.
+	(sldb-insert-frame): Factorized from slime-insert-frames. The
+	frame number in no longer part of the string describing the frame.
+	(sldb-insert-frames): Use it.
+	(sldb-show-frame-details): Print frame numbers.  Fix printing of
+	catch tags.  Move to the start of the frame before at the
+	beginning to get unfontified text properties.
+	(sldb-inspect-condition): New command.
+	(sldb-insert-locals): The :symbol property is now called :name.
+	Fix locals with :id attribute.
+	(slime-open-inspector): Fix the bugs I introduced last time.
+	
+	* swank.lisp (safe-condition-message): New function.
+	(debugger-condition-for-emacs): Used to be
+	format-condition-for-emacs in each backend.  Separate the
+	condition message from the type description.  Update all backends
+	accordingly.
+	(print-with-frame-label): New function. 
+	
+	* slime.el (slime-hyperspec-lookup): New function.
+
+2004-01-02  Wolfgang Jenkner <wjenkner at inode.at>
+
+	* swank-clisp.lisp: New file.  Merged with Vladimir's version.
+
+	* xref.lisp: New file.  Used by swank-clisp.
+
+	* swank-loader.lisp (user-init-file): Add CLISP files.
+	
+	* swank.lisp (eval-region, tokenize-completion): Modify loops a
+	bit to make CLISP happy.
+
+	* swank-backend.lisp (with-compilation-hooks): Replace () with
+	(&rest _) to make CLISP happy.
+
+	* slime.el (slime-goto-source-location): Support for CLISP style
+	line numbers. Split it up.
+	(slime-goto-location-buffer, slime-goto-location-position): New
+	functions.
+	(slime-load-system): Use slime-display-output-buffer.
+	(slime-repl-mode): Disable conservative scrolling. Not sure if it
+	was a good idea.
+	(sldb-insert-frames, sldb-show-frame-details, sldb-list-locals):
+	Minor fixes.
+	(sldb-insert-locals): Renamed from sldb-princ-locals.
+	(sldb-invoke-restart): Use slime-eval instead of
+	slime-oneway-eval, because interactive restarts may read input.
+	(slime-open-inspector): Minor indentation fixes.
+	(slime-net-output-funcall): Removed.  Was unused.
+
+2003-12-19 Alan Ruttenberg <alanr-l at mumble.net>
+	* slime.el 1.157
+	fix bug in sldb-princ-locals I introduced when adding fonts to sldb
+	
+2003-12-19 Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-openmcl.lisp 1.42
+	in request-loop register output stream to be periodically slushed per Gary Byer's email.
+	* slime.el 1.156
+	slime-goto-source-location. Sometimes source information is recorded but it isn't a standard "def"
+	in that case, don't error out, just look for the most likely place for the definition. 
+	
+2003-12-19  Luke Gorrie  <luke at bluetail.com>
+
+	* null-swank-impl.lisp: Deleted this old file. See
+	swank-backend.lisp instead.
+
+2003-12-18 Alan Ruttenberg <alanr-l at mumble.net>
+	* swank-openmcl.lisp 1.41
+	in openmcl (break) now goes into slime debugger. 
+	(setq swank:*break-in-sldb* nil) to disable that.
+	
+2003-12-17 Alan Ruttenberg <alanr-l at mumble.net>
+        * slime.el 1.155
+        Allow font choices for backtrack. Add group for customizing them: sldb.
+	Whole thing is enabled with sldb-enable-styled-backtrace which is off by default, for now.
+	Try
+	 '(sldb-condition-face ((t (:foreground "DarkSlateGray" :weight bold))))
+	 '(sldb-detailed-frame-line-face ((t (:foreground "brown" :weight bold :height 1.2))))
+	 '(sldb-local-name-face ((t (:weight bold))))
+	 '(sldb-restart-face ((t (:foreground "DarkBlue" :weight bold))))
+	 '(sldb-restart-number-face ((t (:underline t :weight bold))))
+	 '(sldb-restart-type-face ((t (:foreground "DarkSlateGrey" :weight bold))))
+	 '(sldb-section-face ((t (:weight bold :height 1.2))))
+	 '(sldb-selected-frame-line-face ((t (:foreground "brown" :weight bold :height 1.2))))
+	 '(sldb-topline-face ((t (:foreground "brown" :weight bold :height 1.2))))
+
+2003-12-17 Alan Ruttenberg <alanr-l at mumble.net>
+        * slime.el 1.154
+	Allow some face choices in the inspector. Try
+	 '(slime-inspector-label-face ((t (:weight bold))))
+	 '(slime-inspector-topline-face ((t (:foreground "brown" :weight bold :height 1.2))))
+	 '(slime-inspector-type-face ((t (:foreground "DarkRed" :weight bold))))
+	You can also set slime-inspector-value-face
+	
+2003-12-17 Alan Ruttenberg <alanr-l at mumble.net>
+
+	* swank-openmcl.lisp 1.40
+	Fix an error with frame-source-location-for-emacs when the
+	function was a method-function.
+	Defined method-source-location that handles this case. You can
+	still end up looking at the wrong definition, as the protocol
+	doesn't allow passing back the qualifiers and specializers to look
+	up the correct one in the file
+
+.	* swank-openmcl.lisp 1.39
+	Allow you to continue after interrupting. 
+	Properly set *swank-debugger-stack-frame* when interrupting.
+
+	* slime.el 1.152
+	sldb-continue now uses slime-oneway-eval
+	
+2003-12-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Better handling of asynchronous output.
+	(slime-output-end): New variable.  Use this marker to insert
+	output.  Insert asynchronous output inserted before the "input
+	region" and before the prompt.
+	(slime-show-last-output): Use it.
+	(slime-repl-insert-prompt): Initialize it.
+	(slime-last-output-start): Removed.
+	(slime-flush-output): Increase delay to 20 usecs.
+	(slime-with-output-end-mark): Renamed from
+	slime-with-output-at-eob.  Insert a newline if needed.
+	(slime-output-string, slime-repl-activate): Use it.
+	(slime-repl-return): Ensure that slime-repl-input-end-mark points
+	to a reasonable location.
+	
+2003-12-17  Luke Gorrie  <luke at bluetail.com>
+
+	* HACKING: New file summarising our way of working.
+
+2003-12-16  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-lisp-preferred-package-nicknames): Removed. Not
+	very interesting (and slightly broken) now that shortest-nicknames
+	are automatically used.
+	(slime-output-oneway-evaluate-request): New function to evaluate
+	an expression for side-effects (without getting a
+	result).
+	(slime-idle-state): Handle new :emacs-evaluate-oneway.
+	(slime-debugging-state): Handle :emacs-evaluate-oneway.
+	(sldb-invoke-restart): Use slime-oneway-eval. This avoids pushing
+	an evaluating state (which will be aborted, and print an unnecessary
+	message saying so).
+	(sldb-break-with-default-debugger): New command to break into the
+	default TTY debugger. Bound to 'B' in *sldb*.
+	(slime-read-string-state): Added :emacs-evaluate-oneway.
+
+	* swank.lisp (invoke-nth-restart-for-emacs): Wrapper around
+	INVOKE-NTH-RESTART that checks that Lisp and Emacs agree on the
+	debug level. This detects and ignores old restart requests when
+	several are sent at once (possible because of new oneway-eval
+	feature).
+	(oneway-eval-string): New function to evaluate a string without
+	sending a result, and with *DEBUGGER-HOOK* bound to NIL. (The
+	debugger hook is inhibited to avoid state conflicts.)
+
+2003-12-15  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-openmcl.lisp (ccl::*warn-if-redefine-kernel*): Support for
+	interrupting the listener (by Alan Ruttenberg).
+
+2003-12-15  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp *start-swank-in-background*: Set to t by default.
+
+	* slime.el (slime-eval-last-expression-display-output): New
+	command.  Bound to C-x M-e.  Suggested by Nicolas Neuss.
+	(slime-display-output-buffer): New function.
+	(slime-slime-compile-file): Use it.
+
+2003-12-15  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (*processing-rpc*, *multiprocessing-enabled*,
+	*debugger-hook-passback*): New variables.
+	(with-conversation-lock, with-I/O-lock): New macros.
+	(read-next-form): Use with-I/O-lock.
+	(send-to-emacs): Use with-I/O-lock.
+	(swank-debugger-hook): When called asynchronously (i.e. not
+	during RPC) and multiprocessing is enabled, suspend until
+	acknowleged by Emacs.
+	(install-global-debugger-hook): Install a SLIME-DEBUGGER-FUNCTION
+	globally on *DEBUGGER-HOOK*.
+	(startup-multiprocessing-for-emacs): Called to initialize multiprocessing.
+	(eval-string): Dynamically set the *PROCESSING-RPC* flag.
+	(eval-string): Nasty hack with *DEBUGGER-HOOK-PASSBACK* to
+	install debugger hook. Temporary, I swear!
+	(eval-region, shortest-package-nickname): Report the shortest
+	package nickname to Emacs (for the REPL prompt). Patch from Marco
+	Baringer.
+
+	* swank-backend.lisp: Defined multiprocessing interface.
+
+	* swank-cmucl.lisp: Implmemented the multiprocessing interface.
+
+	* slime.el (slime-multiprocessing): When true, use
+	multiprocessing in Lisp if available.
+	(slime-global-debugger-hook): When true, globally set
+	*debugger-hook* to use the SLIME debugger. For use with
+	SERVE-EVENT and multiprocessing.
+	(slime-handle-oob): Handle :AWAITING-GOAHEAD message from threads
+	that have suspended to wait for Emacs's attention.
+	(slime-give-goahead): New command to allow a suspended thread to
+	continue (bound to RET in the thread-control-panel).
+	(slime-thread-control-panel): New command to display a buffer
+	showing all threads that are suspending waiting for Emacs's
+	attention. Bound to `C-c C-x t'.
+	(slime-popup-thread-control-panel): When true, automatically
+	popup the thread-control buffer when a new thread suspends.
+
+2003-12-14  Alan Ruttenberg <alanr-l at mumble.net>
+
+	* swank-openmcl.lisp (eval-in-frame, inspect-object and friends):
+	Most of this is copied from swank-cmucl. The parts between &&&&&
+	are what I added for openmcl. I piggyback off the inspector which
+	is shipped with openmcl, so inspecting won't look the same as it
+	would in cmucl, I imagine. Still, it's a start.  eval in frame
+	uses frame-locals to get bindings so if you have debug settings
+	low or don't have *save-local-symbols* set you won't be able to
+	evaluate.
+		
+2003-12-14  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (tracedp, toggle-trace-fdefinition): Moved
+	to swank.lisp.
+
+	* swank-allegro.lisp (create-swank-server): Add support for
+	BACKGROUND and CLOSE argument.
+	(call-with-debugging-environment): Use excl::int-newest-frame to
+	avoid the kludge with *break-hook*.
+	(sldb-abort): New function.
+	(frame-source-location-for-emacs): Dummy definition.
+	(compile-file-for-emacs): The argument is called
+	:load-after-compile and not :load.
+	(xref-results-for-emacs): Use dolist instead of loop.
+
+	* swank-openmcl.lisp (create-swank-server): Add support for
+	BACKGROUND and CLOSE argument.
+	(open-stream-to-emacs): Support for dedicated output stream.
+
+	* swank.lisp: *start-swank-in-background*,
+	*close-swank-socket-after-setup*, *use-dedicated-output-stream*:
+	Moved here from swank-cmucl.
+	(sldb-continue): Don't pass the condition as argument, because
+	that doesn't work with Allegro.
+	(toggle-trace-fdefinition, tracedp): Replace backend specific code
+	with portable, but ugly, calls to eval.
+
+	* swank-cmucl.lisp (compile-system-for-emacs): Add method for
+	CMUCL.
+
+	* slime.el (slime-goto-source-location): Better regexp for package
+	qualified symbols.  Allow dashes in the name and two colons.
+	Reported by Alan Ruttenberg.
+
+2003-12-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-openmcl.lisp (create-swank-server): Interrupt the right
+	thread.  Patch by Alan Ruttenberg.  Not yet enabled, due to lack
+	of test platform.
+	(sldb-disassemble): Implement sldb-disassemble command.  Patch by
+	Alan Ruttenberg.
+	Remove #' from lambdas.
+
+2003-12-12  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (create-swank-server): New keyword arguments to
+	control the server: BACKGROUND and CLOSE.  fd-handlers are used if
+	BACKGROUND is true.  If close CLOSE is true, close the socket
+	after the first connection; keep it open otherwise.
+	*start-swank-in-background*, *close-swank-socket-after-setup*: The
+	default values of the corresponding arguments for
+	create-swank-server.
+	(compile-file-for-emacs): Don't load the fasl-file when the
+	compilation failed.
+
+	* swank-openmcl.lisp (toggle-trace-fdefinition, tracedp):
+	Implement trace command.  Patch by Alan Ruttenberg.
+	(find-function-locations, find-source-locations): Handle
+	variables, and method-combinations.  General cleanups.
+	(source-info-first-file-name): Removed.
+	(list-callers): Fixed.
+	(list-callers): Fixed some more.  method-name is not exported in
+	0.14.  From Marco Baringer.
+	(swank-accept-connection): Accept multiple connections.  Patch by
+	Marco Baringer.
+
+	* swank-loader.lisp (user-init-file): Use homedir's truename.
+	Reported by Friedrich Dominicus.
+
+	* slime.el (slime-repl-current-input): Don't remove the final
+	newline if we are in reading state.
+	(slime-goto-source-location): Regex-quote the function-name and
+	handle package prefixes.  Reported by Alan Ruttenberg.
+	(slime-output-string): Insert asynchronous output before the
+	prompt.
+
+2003-12-12  Daniel Barlow  <dan at telent.net>
+
+	* swank-source-path-parser.lisp: new file, excerpting part of
+	swank-cmucl.lisp to where SBCL can find it as well.
+
+2003-12-11  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-one-line-ify): New function to convert
+	multi-line strings to one-liners by replacing any newline
+	followed by indentation by a single space.
+	(slime-xrefs-for-notes): Use it.
+
+2003-12-11  Daniel Barlow  <dan at telent.net>
+
+	* swank-sbcl.lisp (compiler-note-location): replace with
+	thinly-ported version from the CMUCL backend which understands
+	:lisp as a pathname
+
+	* slime.el (slime-xrefs-for-notes): a little more temporary
+	variables, a little less cdr.  Should be slightly faster on
+	big systems
+	(slime-goto-next-xref): set window point as well as buffer point -
+	now works in GNU Emacs 21.2.1 
+
+	* swank.lisp (swank-compiler): new function abstracts commonality
+	between swank-compile-{file, string}.
+	(swank-load-system): call swank-compiler to load asdf system
+
+	* swank-sbcl.lisp (compiler-note-location and elsewhere): 
+	remove all trace of *compile-filename*
+	(compile-*-for-emacs): shorten
+
+	* swank-backend.lisp (call-with-compilation-hooks): new GF
+	should set up all appropriate error condition loggers etc
+	to do a compilation preserving the notes.  Implement for
+	sbcl, cmucl
+
+	* slime.el (slime-find-asd, slime-load-system): new command
+	to compile and load an ASDF system with all the usual compiler
+	notes and stuff
+	(slime-compilation-finished): if more than one file has new 
+	errors/notes, create an xref buffer to show them all
+	(slime-remove-old-overlays): bug fix: now removes overlays even
+	at start of buffer
+	(slime-overlay-note): do nothing quietly if
+	slime-choose-overlay-region returns nil
+	(slime-choose-overlay-region): return nil if note has no location
+
+2003-12-11  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-repl-previous-prompt, slime-repl-next-prompt):
+	New commands.  Suggested by Håkon Alstadheim.
+	(slime-repl-beginning-of-defun, slime-repl-end-of-defun): New
+	commands.  Suggested by Andreas Fuchs.
+	(slime-repl-insert-prompt): Mark the prompt with a
+	slime-repl-prompt text property.
+	(slime-repl-eol): New function. Mostly for symmetry.
+	(slime-repl-in-input-area-p, slime-repl-at-prompt-end-p): New
+	predicates.
+	(slime-repl-find-prompt, slime-search-property-change-fn): New
+	functions.
+	(slime-ir1-expand): New command.
+
+	* swank-cmucl.lisp (accept-connection, request-loop): Don't use
+	fd-handlers. The code for the request-loop itself is now almost
+	the same as in the Allegro version.
+	(print-ir1-converted-blocks, expand-ir1-top-level): New functions.
+
+2003-12-10  Daniel Barlow  <dan at telent.net>
+
+	* swank-sbcl.lisp (serve-request): more fiddling with serve-event
+	descriptors
+
+	* slime.el (slime-repl-return): slime-check-connected, otherwise
+	pressing Return in an unconnected repl gets a bit weird 
+
+2003-12-10  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp, swank-lispworks.lisp, swank-openmcl.lisp,
+	swank-sbcl.lisp (create-swank-server): Accept an announce-function
+	keyword argument.
+
+	* swank.lisp (start-server): Pass an announce callback function to
+	create-swank-server.  Works better with single threaded
+	implementations.
+	(announce-server-port, simple-announce-function): New functions.
+	(alistify): Doc fix.
+
+	* swank-cmucl.lisp (create-swank-server): Use announce callback.
+	(sldb-disassemble): New function.
+
+	* slime.el (sldb-disassemble): New command. Bound to D.
+
+2003-12-08  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-cmucl.lisp (*debug-definition-finding*): Now nil by
+	default, so that errors while looking for definitions are printed
+	as a message and not debugged.
+
+	* slime.el (slime-read-from-minibuffer): Now the only
+	completing-read function, stale ones deleted.
+
+2003-12-07  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-prune-initial-frames): Use regexp-heuristics and
+	the '--more--' token to avoid showing the user Swank-internal
+	backtrace frames initially.
+	(slime-repl-current-input): Don't include the final newline
+	character, to make backtraces prettier.
+	(slime-autodoc): Fixed annoying case where autodocs would be
+	fetched in a loop for undocumented symbols.
+
+	* swank.lisp (compound-prefix-match): New name and rewritten for
+	speed. Completion is much faster now.
+	(*sldb-initial-frames*): Send up to this many (default 20)
+	backtrace frames to Emacs when entering the debugger.
+
+2003-12-07  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp, swank-backend.lisp, swank-cmucl.lisp,
+	swank-lispworks.lisp, swank-openmcl.lisp, swank-sbcl.lisp
+	(function-source-locations): Make it at generic function.
+	(function-source-location-for-emacs): Removed.  Fixes bug reported
+	by Marco Baringer.
+
+	* slime.el (slime-interactive-eval): Insert the result at point,
+	if called with prefix argument.
+
+2003-12-06  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-easy-menu): Added menubar support, contributed
+	by Friedrich Dominicus.
+
+2003-12-06  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-allegro.lisp: New file.
+
+	* swank-loader.lisp (user-init-file): Translate logical
+	pathnames.  Reported by Friedrich Dominicus.
+
+	* swank-sbcl.lisp (handle-notification-condition): Don't ignore
+	warnings without context.
+	(compiler-note-location, brief-compiler-message-for-emacs,
+	compiler-note-location): Handle null context.
+	(compile-file-for-emacs): Bind *compile-filename* and load the
+	fasl file only if it exists.
+	(function-source-location): The name argument is now optional and
+	should be a symbol.
+	(find-function-locations): Return errors as a list of one error.
+	(call-with-debugging-environment): Set *print-level* to 4 and
+	*print-length* to 10.  (Both where nil.)
+	(source-location-for-emacs): Fall back to the location of the
+	function, if there is no debug-block-info.
+	(safe-source-location-for-emacs): Don't catch all conditions; only
+	errors.  
+	*compile-filename*: New variable
+	(open-listener): Don't make the socket non-blocking.
+
+	* slime.el (slime-eval/compile-defun-dwim): New command.
+	Suggested by "jan" <janmar at iprimus.com.au>.
+
+2003-12-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-debugging-state): Don't set sldb-level after
+	sldb-setup. Breaks the test-suite.
+	(slime-eval-defun): Fix typos.
+	(slime-xref-buffer, slime-goto-next-xref): Updated for the new
+	xref code.
+	(sldb-inspect-in-frame): Query with the sexp at point as initial
+	value.
+	(sldb-step): New command. Bound to s.
+
+	* swank-cmucl.lisp (format-frame-for-emacs, compute-backtrace,
+	backtrace): Don't send CMUCL's frame numbers to Emacs, use our own
+	numbering.
+	(set-step-breakpoints, sldb-step): Lisp side of sldb-step command.
+
+2003-12-04  Luke Gorrie  <luke at bluetail.com>
+
+	* hyperspec.el: Updated URL to point to a live copy of the
+	hyperspec at lispworks.com, because the one on xanalys.com has
+	disappeared. Patch from Vincent Arkesteijn on the ilisp-devel
+	mailing list.
+
+2003-12-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (toggle-trace-fdefinition, tracedp): New
+	support functions for toggle-trace command.  Written by Alain
+	Picard.
+	(compile-from-temp-file): Don't delete the binary file if there is
+	none.
+	(lispworks-severity): Map all ERRORs to :error.
+
+	* slime.el (slime-eval-defun): Use slime-re-evaluate-defvar if the
+	defun starts with "defvar".  C-M-x in elisp does this too.
+	(slime-re-evaluate-defvar): Take the form as argument.
+
+2003-12-03  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-debugging-state): Initialize the sldb-buffer if
+	(/= sldb-level level).
+	(slime-who-specializes): New command.
+
+	* swank-cmucl.lisp (create-swank-server): Set reuse-address to t
+	by default.
+	(resolve-note-location): Add method for warnings in interpreted
+	code.
+	(who-specializes): New function.
+	(dd-source-location): Handle case without constructors more
+	correctly.
+	(source-path-source-position): Skip ambigous entries in
+	source-map.
+	(source-location-from-code-location): Simplified.
+
+2003-12-03  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-completing-read-internal): Fix from Sean
+	O'Rourke.
+
+2003-12-02  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-sbcl.lisp (find-function-locations): Return a non-empty
+	list of source locations.
+
+	* slime.el (slime-with-xref-buffer): Remove spurious comma. (Bug
+	reported by Raymond Wiker).  Some reordering of the xref code.
+
+	* swank.lisp (documentation-symbol): New optional argument for
+	return value if the symbol is not documented.
+
+2003-12-02  Sean O'Rourke  <sorourke at cs.ucsd.edu>
+
+        * slime.el: (slime-repl-{clear-buffer,clear-output}): clear the
+	last and entire output in the *slime-repl* buffer
+	(slime-documentation): pop up a buffer with a symbol's
+	documentation instead of its description, if found.
+	(slime-complete-symbol): tweak the completion, taken from ilisp, to
+	complete filenames inside strings.
+	(slime-set-default-directory): also set *slime-repl*'s
+	default-directory, so e.g. find-file makes sense.
+	
+2003-12-02  Daniel Barlow  <dan at telent.net>
+
+	* slime.el (slime-with-xref-buffer): moved further up the file so
+	it's defined before slime-show-xrefs needs it
+
+	* swank-sbcl.lisp (function-source-location-for-emacs): return a
+	list of source locations (one per method) when the request is
+	for a GF.  This seems to make the elisp side popup a window
+	to let the user select one.  Cool.
+
+2003-12-01  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-[cmucl,sbcl,openmcl,lispworks].lisp (invoke-nth-restart):
+	Use invoke-restart-interactively.
+
+	* slime.el (slime-create-note-overlay, slime-sexp-depth): The
+	'priority' property is unused. Remove it.
+
+	* swank-openmcl.lisp (find-function-locations): Return all methods
+	for generic functions. Doesn't work very well if multiple methods
+	are in the same file.
+	(swank-accept-connection): Don't create an extra thread, call
+	request-loop directly.
+
+2003-12-01  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-repl-return): Goto end of input area before
+	inserting newline.
+	(slime-autodoc-message-ok-p): Test to see if a documentation
+	message should be printed (returns nil if the
+	minibuffer/echo-area is already being used).
+	(slime-symbol-at-point): Skip back over whitespace before
+	looking for the symbol.
+	(slime-autodoc-delay): New configurable to specify the delay
+	before printing an autodoc message (default 0.2 secs).
+	(slime-ensure-typeout-frame): New function to call create a
+	typeout frame unless it already exists. Suitable to run on
+	slime-mode-hook if you always want to have a typeout window.
+	(slime-log-events): When nil, don't log events to
+	*slime-events*. This works-around a problem Raymond Toy has when
+	starting SLIME under XEmacs. Still investigating..
+
+2003-11-29  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+	
+	* slime.el: Rewrite the xref code to work with other source
+	locations.
+	(slime-edit-fdefinition): Use the xref window to display generic
+	functions with methods.
+	(slime-goto-source-location): New representation for source
+	locations. Drop old code.
+	(slime-list-callers, slime-list-callees): Use the xref window.
+	Remove the slime-select-* stuff.
+	(slime-describe-function): New command. Bound to C-c C-f.
+	Primarily useful in Lispworks.
+	(slime-complete-symbol): Display the completion window if the
+	prefix is complete but not unique.
+	(slime-forward-positioned-source-path): Enter the sexp only if the
+	remaining sourcepath is not empty.
+	(slime-read-symbol-name): New optional argument QUERY forces
+	querying.
+
+	* swank.lisp (group-xrefs): Handle unresolved source locations.
+	(describe-symbol): Print something sensible about unknown symbols.
+
+	* swank-cmucl.lisp: Use the new format for source locations.
+	(find-function-locations): New function.  Replaces
+	function-source-location-for-emacs.  Returns a list of
+	source-locations.
+	(resolve-note-location): Renamed from resolve-location.
+	Simplified.
+	(brief-compiler-message-for-emacs): Print the source context
+	 (that's the thing after ==>).
+	(who-xxxx): Take strings, not symbols, as arguments.
+	(function-callees, function-callers): Use the same format as the
+	who-xxx functions.  Support for byte-compiled stuff.
+	(code-location-stream-position): Try to be clever is the source
+	path doesn't match the form.
+	(call-with-debugging-environment): Bind *print-readably* to nil.
+
+	* swank-lispworks.lisp: Use the new format for source
+	locations. Implement the find-function-locations.
+	(list-callers, list-callers): New functions.
+
+	* swank-sbcl.lisp, swank-openmcl.lisp: Use the new format for
+	source locations and implement find-function-locations (just calls
+	the old code).
+
+2003-11-29  Daniel Barlow  <dan at telent.net>
+
+	* swank-sbcl.lisp (source-location-for-emacs):
+	sb-debug::print-description-to-string takes only two args, not
+	three.  Now 'v' command works in sldb :-)
+
+	* slime.el (slime-idle-state): added :debug as a valid transition
+
+	* swank.lisp (slime-debugger-function): New.  Returns a function
+	suitable for use as the value of *DEBUGGER-HOOK* to install the
+	SLIME debugger globally.  Must be run from the *slime-repl* buffer
+	or somewhere else that the slime streams are visible so that it
+	can capture them.  e.g. for Araneida:
+	PKG> (setf araneida:*restart-on-handler-errors* 
+	           (swank:slime-debugger-fucntion))
+
+2003-11-29  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Some tweaking to the REPL.  slime-repl-input-end-mark
+	is now always left inserting and slime-mark-input-end
+	"deactivates" the end mark by moving it to the beginning of the
+	buffer.
+	(slime-goto-source-location): Next try for more uniform
+	source-locations.  A source-location is now a structure with a
+	"buffer-designator" and  "position-designator".  The buffer-designator
+	open the file or buffer and the position-designator moves point to the
+	right position.
+	(slime-autodoc-mode): New command.
+	(slime-find-fdefinitions): Experimental support for generic functions
+	with methods.
+	(slime-show-xrefs, slime-insert-xrefs, slime-goto-xref): Rewritten to
+	work with more general source locations.
+
+	* swank.lisp: Structure definitions for source-locations.
+	(alistify, location-position<, group-xrefs): Utilities for xref
+	support.
+
+	* swank-cmucl.lisp (code-location-source-location): Renamed from
+	safe-source-location-for-emacs.
+	(code-location-from-source-location): Renamed from
+	source-location-for-emacs.
+	(find-fdefinitions, function-source-locations): New functions.
+	(safe-definition-finding): New macro.
+
+	* swank-lispworks.lisp: Xref support.
+	(make-dspec-location): Updated for the new source-location format.
+
+2003-11-29  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (complete-symbol, arglist): Updated test cases for new
+	completion interface.
+
+2003-11-28  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-complete-symbol): Use the new completion
+	support from the Lisp side. Don't obscure minibuffer input with
+	completion messages.
+
+	* completer.el: Dead and buried! Replaced by half a page of Common
+	Lisp. Thanks Bill Clementson for a motivational and well-deserved
+	taunt.
+
+	* swank.lisp (longest-completion): Compute the best partial
+	completion for Emacs.
+
+	* slime.el (slime-swank-port-file): Try (temp-directory),
+	temporary-file-directory, or "/tmp/", depending on what
+	is (f)bound.
+
+2003-11-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp (make-dspec-location): Handle logical
+	pathnames.  Reported by Alain Picard.
+
+	* swank-sbcl.lisp, swank-cmucl.lisp: Support for output
+	redirection to an Emacs buffer via a dedicated network stream.
+	Can be enabled with *use-dedicated-output-stream*.
+
+	* swank.lisp (slime-read-string, eval-string): Flush *emacs-io*.
+	(eval-in-emacs): New function.
+
+	* slime.el: Support for output from a dedicated socket.
+	(slime-open-stream-to-lisp, slime-output-filter): New functions.
+	Reorganized REPL code a bit.
+	(slime-input-complete-p): Use vanilla forward-sexp, because
+	slime-forward-sexp sometimes caused endless loops.
+	(slime-disconnect): Close the output-stream-connection if present.
+	(slime-handle-oob): A new :%apply event.  Executes arbitrary code;
+	useful for bootstrapping.
+	(slime-flush-output): New function.
+	(slime-symbol-end-pos): Didn't work at all in Emacs20.  Just use
+	point until someone commits a proper fix.
+	Various uses of display-buffer: The second argument is different in
+	XEmacs.
+	(interrupt-bubbling-idiot): Reduce the timeout to 5 seconds.
+	
+2003-11-27  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-swank-port-file): Use `temporary-file-directory'
+	instead of hardcoding "/tmp/".
+
+2003-11-27  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-lispworks.lisp: New backend.
+	
+	* slime.el (slime-with-output-to-temp-buffer): Save the window
+	configuration in a buffer local variable instead on a global
+	stack.
+	(slime-show-last-output): Behavior customizable with
+	slime-show-last-output-function.  Various tweaking for better
+	multi-frame support.
+
+	* swank-backend.lisp: List exported symbols explicitly.
+
+	* swank-cmucl.lisp (function-source-location): Better support for
+	generic functions.
+
+	* swank.lisp (briefly-describe-symbol-for-emacs): Don't return
+	unbound symbols.
+	(describe-symbol, describe-function): Support package-qualified
+	strings.
+
+	* swank-loader.lisp: *sysdep-pathnames*: Add Lispworks files.
+	(compile-files-if-needed-serially): Compile all files in a
+	compilation unit.
+
+2003-11-27  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-complete-symbol): Make a bogus alist out of the
+	completion set, for compatibility with XEmacs.
+
+	* completer.el: Stolen^Wimported from ILISP version 1.4. This is
+	one revision prior to their latest, where they added a (require)
+	for some other ILISP code. I backed down a revision to make it
+	stand-alone, but this may mean that putting SLIME in the load-path
+	before ILISP will break ILISP. So, beware.
+	(completer-message): Cut dependency on undefined ilisp constant
+	testing for xemacs.
+
+2003-11-27  Zach Beane  <xach at xach.com>
+
+	* swank.lisp (completions): Complete compound symbols (see below).
+
+	* slime.el (slime-complete-symbol): Use `completer' package to
+	handle more sophisticated completions. This includes abbreviations
+	like "m-v-b" => "multiple-value-bind". It also (somewhat scarily)
+	redefines other standard Emacs completion functions with similar
+	capabilities. See commentary in completer.erl for details.
+
+2003-11-25  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-make-typeout-frame): New command to create a
+	frame where commands can print messages that would otherwise go to
+	the echo area.
+	(slime-background-message): Function for printing "background"
+	messages. Uses the "typeout-frame" if it exists.
+	(slime-arglist): Print arglist with `slime-background-message'.
+	(slime-message): Use typeout frame if it exists, but only for
+	multi-line messages.
+
+2003-11-25  Daniel Barlow  <dan at telent.net>
+
+	* swank-sbcl.lisp: delete big chunk of leftover commented-out 
+	code
+
+	* slime.el: arglist command to use slime-read-symbol-name,
+	not slime-read-symbol
+
+	* README: Minor updates for currency
+
+2003-11-24  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-backend.lisp (compiler-condition): Removed use of
+	:documentation slot option. That is not portable (to CMUCL 18e).
+
+	* swank.lisp (eval-string-in-frame): Fixed symbol-visibility
+	problem (thanks Lawrence Mitchell).
+
+	* swank-sbcl.lisp (function-source-location): Use TRUENAME to
+	resolve source file name (thanks Lawrence Mitchell).
+
+	* slime.el (slime-goto-source-location): Fixes when finding
+	definition by regexp: open the right file (was missed), and
+	tweaked regexp to match more 'def' forms - especially
+	`defmacro-mundanely' (hyphen wasn't allowed before).
+
+2003-11-23  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-fetch-more-frames): Call swank:backtrace instead
+	of (renamed) swank:backtrace-for-emacs.
+
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-openmcl-lisp: Updated
+	to use new debugger interfaces in swank-backend.lisp.
+
+	* swank-backend.lisp (backtrace, eval-in-frame, frame-catch-tags,
+	frame-locals, frame-source-location-for-emacs): More interface
+	functions.
+
+	* slime.el (slime-goto-source-location): Added optional `align-p'
+	argument for :file and :emacs-buffer location types. This is for
+	OpenMCL - unlike CMUCL its positions are not character-accurate so
+	it needs to be aligned to the beginning of the sexp.
+	(slime-connect): Don't delete a random window when *inferior-lisp*
+	isn't visible.
+
+	* swank-cmucl.lisp: Tidied up outline-minor-mode structure and
+	added comments and docstrings.
+
+	* swank-cmucl.lisp, swank-sbcl.lisp, swank-openmcl-lisp: Updated
+	to use new debugger interface in swank-backend.lisp.
+
+	* swank-backend.lisp (call-with-debugging-environment,
+	sldb-condition, debugger-info-for-emacs): More callbacks defined.
+
+	* swank.lisp: Tidied up outline-minor-mode structure, added
+	comments and docstrings.
+	(sldb-loop): Took over the main debugger loop.
+
+	* swank-openmcl.lisp: Updated after refactoring of other backends
+	(was broken).
+
+	* slime.el (slime-goto-source-location): Align at beginning of
+	sexp after (:file name pos) and (:emacs-buffer buffer pos).
+
+	* swank-sbcl.lisp (describe-symbol-for-emacs): Don't ask for
+	(documentation SYM 'class), CLHS says there isn't any 'class
+	documentation (and SBCL warns).
+
+	* swank.lisp, swank-cmucl.lisp, swank-sbcl.lisp: Refactored
+	interface through swank-backend.lisp for: swank-compile-file,
+	swank-compile-string, describe-symbol-for-emacs (apropos),
+	macroexpand-all, arglist-string.
+
+	* swank-backend.lisp: New file defining the interface between
+	swank.lisp and the swank-*.lisp implementation files.
+
+2003-11-22  Brian Mastenbrook  <bmastenb at cs.indiana.edu>
+
+	* swank.asd: ASDF definition to load "swank-loader.lisp". This is
+	useful for starting the Swank server in a separate Lisp and later
+	connecting with Emacs. The file includes commentary.
+
+2003-11-22  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-connect): Slightly reordered some window
+	operations to ensure that *slime-repl* is popped up after `M-x
+	slime-connect'.
+	(slime-show-last-output): If the *slime-repl* buffer is already
+	visible in any frame, don't change anything.
+
+	* swank.lisp (listener-eval): Format results in *buffer-package*.
+	Exporting (CREATE-SWANK-SERVER <port>). This function can be
+	called directly to start a swank server, which you can then
+	connect to with `M-x slime-connect'. It takes a port number as
+	argument, but this can be zero to use a random available port.
+	The function always returns the actual port number being used.
+
+2003-11-19  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp: Better printing off return values.  In the REPL
+	buffer we print now every value in a separate line and in the echo
+	area separated by a comma.  We also print "; No value" for the
+	degenerated case (values).  A new variable *sldb-pprint-frames*
+	controls the printing of frames in the debugger. (Thanks Raymond
+	Toy for the suggestions.)
+
+	* swank-cmucl.lisp (format-frame-for-emacs): Bind *pretty-print*
+	to *sldb-pprint-frames*.
+
+	* slime.el: Window configuration are now saved on a stack, not in
+	a single global variable.
+	(slime-with-output-to-temp-buffer) We use now our own version of
+	with-output-to-temp-buffer.  The default version is painfully
+	incompatible between Emacs versions.  The version selects the
+	temporary buffer and the behaivor of "q" is now more consistent
+	(as suggested by Jan Rychter).
+	(slime-connect): Hide the *inferior-lisp-buffer* when we are
+	connected.  
+	sldb-mode-map: Bind n and p to sldb-down and sldb-up.
+	(slime-edit-fdefinition-other-window): New function. Suggested by
+	Christian Lynbech.
+	
+	* swank-loader.lisp (user-init-file): There is now a user init
+	file (~/.swank.lisp).  It is loaded after the other files.
+
+2003-11-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: [slime-keys] Override C-c C-r with slime-eval-region
+	 (reported by Paolo Amoroso).
+	
+	* swank-loader.lisp: Compile and load gray stream stuff for SBCL
+	and OpenMCL.
+
+	* swank-openmcl.lisp, swank-sbcl.lisp: Import gray stream symbols.
+	(without-interrupts*): New function.
+
+	* swank.lisp (send-to-emacs): Protect the write operations by a
+	without-interrupts, so that we don't trash the *cl-connection*
+	buffer with partially written messages.
+
+	* swank-cmucl.lisp (without-interrupts*): New function.
+
+	* swank-gray.lisp (stream-write-char): Don't flush the buffer on
+	newlines.
+
+	* slime.el: Add some docstring.
+	(interrupt-bubbling-idiot): New test.
+	[slime-keys]:  Don't bind "\C- ".  Problematic on LinuxPPC.
+
+2003-11-15  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Some tweaking for better scrolling in the *slime-repl*
+	buffer (suggested by Jan Rychter).
+	(slime-compile-file): Display the output buffer at the beginning.
+	(slime-show-last-output): Include the prompt so that window-point
+	is updated properly.
+	(slime-with-output-at-eob): Update window-point if the buffer is
+	visible.
+	(slime-state/event-panic): Include the *slime-events* and
+	*cl-connection* buffers in the report.
+
+	* swank-cmucl.lisp (sos/out): Don't flush the buffer on newlines.
+
+2003-11-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Imititate an "output-mark".  Output from Lisp should
+	move point only if point is at the end of the buffer. (Thanks
+	William Halliburton for the suggestion.)
+	(slime-with-output-at-eob): New function.
+	(slime-output-string, slime-repl-maybe-prompt): Use it.
+
+	slime-repl-mode-map: Override "\C-\M-x". 
+
+	An experimental scratch buffer:
+	(slime-eval-print-last-expression): New function.
+	(slime-scratch-mode-map, slime-scratch-buffer,
+	 slime-switch-to-scratch-buffer, slime-scratch): New functions.
+
+	* swank-cmucl.lisp (resolve-location): Emacs buffer positions are
+	1 based.  Add 1 to the 0 based file-position.
+
+2003-11-13  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-connect): pop-to-buffer into *slime-repl* when
+	we connect.
+
+2003-11-13  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el, swank-cmucl.lisp, swank-sbcl.lisp, swank-openmcl: New
+	representation for "source-locations".  Compiler notes have now a
+	message, a severity, and a source-location field.  Compiler notes,
+	edit-definition, and the debugger all use now the same
+	representation for source-location.  CMUCL does the source-path to
+	file-position translation at the Lisp side.  This works better
+	with reader macros, in particular with backquote.  The SBCL
+	backend still does the translation on the Emacs side.  OpenMCL
+	support is probably totally broken at the moment
+ 	
+2003-11-13  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-repl-previous-input, slime-repl-next-input):
+	When partial input has already been entered, the M-{p,n} REPL
+	history commands only match lines that start with the
+	already-entered prefix. This is comint-compatible behaviour which
+	has been requested. The history commands also skip over line
+	identical to the one already entered.
+	(slime-complete-maybe-restore-window-confguration): Catch errors,
+	so that we don't cause `pre-command-hook' to be killed.
+	(slime-truncate-lines): If you set this to nil, slime won't set
+	`truncate-lines' in buffers like sldb, apropos, etc.
+
+2003-11-12  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-show-description): XEmacs portability: don't use
+	`temp-buffer-show-hook'.
+	(slime-inspect): Use `(slime-sexp-at-point)' as default inspection
+	value (thanks Jan Rychter).
+
+2003-11-10  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-post-command-hook): Inhibit unless (still) in
+	slime-mode. Only call `slime-autodoc-post-command-hook' when
+	`slime-autodoc-mode' is non-nil.
+	(slime-setup-command-hooks): Use `make-local-hook' instead of
+	`make-local-variable'.
+
+2003-11-08  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: slime-highlight-face: Use the :inherit attribute if
+	possible.
+	(slime-face-inheritance-possible-p): New function.
+
+	* slime.el (slime-repl-return): Only send the current input to
+	Lisp if it is a complete expression, like inferior-slime-return.
+
+	* swank.lisp (completions): Use *buffer-package* if no other
+	package is given.
+
+	* slime.el: Remove the non-working face inheriting stuff.
+	Hardcode colors for slime-highlight-face and specify the :inherit
+	attribute for slime-repl-output-face.  So Emacs21 will do the
+	right thing and the others get at least a customizable face.
+
+	* slime.el (slime-buffer-package): Try to find be the
+	package name before resorting to slime-buffer-package.  Return nil
+	and not "CL-USER" if the package cannot be determined.
+	(slime-goto-location): Insert notes with a source path, but
+	without filename or buffername, at point.  This can happen for
+	warnings during macro expansion. (The macro expander is a
+	interpreted function and doesn't have a filename or buffername.)
+	(slime-show-note): Display 2 double quotes "" in the echo area for
+	zero length messages.  SERIES tends to signal warnings with zero
+	length messages.
+	(slime-print-apropos): Add support for alien types.
+
+	* swank-cmucl.lisp (briefly-describe-symbol-for-emacs): Add
+	support for alien types.
+	(source-path-file-position): Read the entire expression with a
+	special readtable.  The readtable records source positions for
+	each sub-expression in a hashtable.  Extract the sub-expression
+	for the source path from the read object and lookup the
+	sub-expression in the hashtable to find its source position.
+
+	* swank-sbcl.lisp (swank-macroexpand-all): Implemented.
+
+2003-11-06  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-autodoc-mode): When non-nil, display the
+	argument list for the function-call near point each time the point
+	moves in a slime-mode buffer. This is a first-cut; more useful
+	context-sensitive help to follow (e.g. looking up variable
+	documentation).
+	(slime-autodoc-cache-type): Cache policy "autodoc" documentation:
+	either nil (no caching), 'last (the default - cache most recent
+	only), or 'all (cache everything on symbol plists forever).
+
+	* slime.el: Convenience macros:
+	(when-bind (var exp) &rest body)
+	  => (let ((var exp)) (when var . body))
+	(with-lexical-bindings (var1 ...) . body)
+	  => (lexical-let ((var1 var1) ...) . body)
+
+	* slime.el (slime, slime-lisp-package): Reset `slime-lisp-package'
+	(the REPL package) when reconnecting.
+	(slime-buffer-package): Return `slime-lisp-package' when the
+	major-mode is `slime-repl-mode'.
+
+2003-11-04  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-read-string-state): Add support for evaluation
+	requests.
+	(slime-repl-read-break): New command.
+	alternative.
+	slime-keys: XEmacs cannot rebind C-c C-g.  Use C-c C-b as an
+	alternative.
+	(slime-selector): XEmacs has no prompt argument for read-char.
+	(slime-underline-color, slime-face-attributes): Make face
+	definitions compatible with XEmacs and Emacs20.
+	(slime-disconnect): Delete the buffer of the socket.
+	(slime-net-connect): Prefix the connection buffer name with a
+	space to avoid accidental deletion.
+
+	* swank.lisp (slime-read-string): Send a :read-aborted event for
+	non-local exits.
+	(case-convert): Handle :invert case better.
+
+2003-11-03  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-display-message-or-view,
+	slime-remove-message-window): Display too long lines in a new
+	window.  Add a temporary pre-command-hook to remove the multiline
+	window before the next command is executed.
+
+	(slime-complete-symbol): Save the window configuration before
+	displaying the completions and try to restore it later.  The
+	configuration is restored when: (a) the completion is unique (b) there
+	are no completion.  It is also possible to delay the restoration until
+	(c) certain characters, e.g, space or a closing paren, are inserted.
+
+	(slime-selector): Don't abort when an unkown character is pressed;
+	display a message and continue.  Similiar for ?\?.  Add a selector for
+	the *sldb* buffer.
+
+	(slbd-hook, sldb-xemacs-post-command-hook): Emulate Emacs'
+	point-entered text property with a post-command hook.
+
+	* swank.lisp (case-convert, find-symbol-designator): New
+	functions.
+
+	* swank-cmucl.lisp, swank-openmcl.lisp, swank-sbcl.lisp
+	(arglist-string): Don't intern the function name.  Use
+	find-symbol-designator instead.
+
+2003-11-03  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-display-buffer-region): Hacked to fix completely
+	inexplicable XEmacs problems.
+
+2003-11-2  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* null-swank-impl.lisp, swank-cmucl.lisp, swank-openmcl.lisp,
+	swank.lisp: Input redirection works now on the line level, like a
+	tty.  Output streams are now line buffered.  We no longer compute
+	the backtrace-length.
+
+	* slime.el:
+	(slime-repl-read-mode, slime-repl-read-string, slime-repl-return,
+	slime-repl-send-string, slime-read-string-state,
+	slime-activate-state): Reorganize input redirection.  We no longer
+	work on the character level but on a line or region; more like a
+	terminal.  This works better, because REPLs and debuggers are
+	usually written with a line buffering tty in mind.
+	(sldb-backtrace-length, slime-debugging-state,
+	slime-evaluating-state, sldb-setup, sldb-mode, sldb-insert-frames,
+	sldb-fetch-more-frames): Don't use backtrace-length.  Computing
+	the length of the backtrace is (somewhat strangely) an expensive
+	operation in CMUCL, e.g., it takes >30 seconds to compute the
+	length when the yellow zone stack guard is hit.
+
+2003-11-02  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-log-event): Added a *slime-events* buffer
+	recording all state machine events. The buffer uses hideshow-mode
+	to fold messages down to single lines.
+	(slime-show-source-location): Bugfix: only create source-highlight
+	overlay if the source was actually located.
+	(slime-selector): Renamed from `slime-select' because that
+	function name was already in use. Ooops!
+
+	* swank.lisp (eval-string): force-output on *slime-output* before
+	returning the result. This somewhat works around some trouble
+	where output printed by lisp is being buffered too long.
+
+	* slime.el (slime-lisp-package-translations): Association list of
+	preferred package nicknames, for the REPL prompt. By default maps
+	COMMON-LISP->CL and COMMON-LISP-USER->CL-USER.
+
+2003-11-01  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-select): Added an extensible "Select" command,
+	which I gather is a LispM/Martin-Cracauer knock-off. When invoked,
+	the select command reads a single character and uses that to
+	decide which buffer to switch to. New characters can be defined,
+	and the currently availables ones can be seen with '?'. I have not
+	assigned a key to Select, because it seems like a command that
+	should have a global binding. I would suggest `C-c s'.
+
+	* swank.lisp (*slime-features*): Variable remembering the FEATURES
+	list.
+	(sync-state-to-emacs): Update Emacs about any state changes -
+	currently this just means changes to the FEATURES list.
+	(eval-string): Call `sync-state-to-emacs' before sending result.
+	(eval-region): With optional PACKAGE-UPDATE-P, if the evaluation
+	changes the current package, tell Emacs about the new package.
+	(listener-eval): Tell `eval-region' to notify Emacs of package
+	changes, so that e.g. (in-package :swank) does the right thing
+	when evaluated in the REPL.
+
+	* slime.el (slime-repl-output-face, slime-repl-input-face): Face
+	definitions for output printed by Lisp and for previous REPL user
+	inputs, respectively. Defaulting the input face to bold rather
+	than underline, because it looks better on multi-line input.
+	(slime-handle-oob): Two new out-of-band messages
+	(:new-features FEATURES) and (:new-package PACKAGE-NAME). These
+	are used for Lisp to tell Emacs about changes to *FEATURES* and
+	*PACKAGE* when appropriate.
+	(slime-same-line-p): Better implementation (does what the name
+	suggests).
+	(slime-lisp-package): New variable keeping track of *PACKAGE* in
+	Lisp -- or at least, the package to use for the REPL.
+	(slime-repl-insert-prompt): The prompt now includes the package
+	name.
+	(slime-repl-bol): C-a in the REPL now stops at the prompt.
+	(slime-repl-closing-return): C-RET & C-M-m now close all open
+	lists and then send input in REPL.
+	(slime-repl-newline-and-indent): C-j in REPL is now better with
+	indentation (won't get confused by unmatched quotes etc appearing
+	before the prompt).
+
+2003-11-1  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-debugging-state): Save the window configuration
+	in a state variable.  
+	sldb-saved-window-configuration: Removed.
+	(slime-repl-mode): Use conservative scrolling.
+	(slime-repl-insert-prompt): Set window-point after the prompt.
+	(slime-repl-add-to-input-history): Don't add subsequent duplicates to
+	the history.
+
+	* swank.lisp (slime-read-char): Flush the output before reading.
+	(listener-eval): Like eval region but set reader variables (*, **,
+	*** etc.)
+
+	* swank-openmcl.lisp, swank-sbcl.lisp: Implement stream-line-column.
+
+	* swank-cmucl.lisp (slime-input-stream-misc-ops): Renamed from
+	slime-input-stream-misc.
+
+2003-10-31  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-repl-mode-map): Bound `slime-interrupt' on both
+	C-c C-c and C-c C-g.
+
+	* swank.lisp (interactive-eval): Evaluate in *buffer-package*.
+
+	* slime.el: Tweaked debugger window management somewhat: the
+	window configuration is saved when the debugger is first entered
+	and then restored when the idle state is reached.
+
+2003-10-31  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: (slime-repl-read-mode, slime-repl-read-xxx): New minor
+	mode for stream character based input to Lisp.
+
+	* swank.lisp: *read-input-catch-tag*, take-input, slime-read-char:
+	Moved here from swank-cmucl.lisp.
+	(defslimefun, defslimefun-unimplemented): Move macro definitions to
+	the beginning of the file.
+
+	* swank-cmucl.lisp: (slime-input-stream, slime-input-stream-read-char,
+	lime-input-stream-misc): Character input stream from Emacs.
+	(slime-input-stream/n-bin): Removed.
+
+	* swank-openmcl.lisp, swank-sbcl.lisp: Gray stream based input
+	redirection from Emacs.
+	
+2003-10-29  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el:
+	Beginnings of a REPL-mode.
+	Minor debugger cleanups.
+
+	* swank.lisp:
+	slime-read-error: New condition.
+	(read-next-form): Re-signal the conditions as slime-read-errors.  And
+	check the result of read-sequence (i.e. detect CMUCL's read-sequence
+	bug).
+	(sldb-continue, throw-to-toplevel): Was more or less the same in all
+	backends.
+
+	* swank-openmcl.lisp, swank-sbcl.lisp, swank-cmucl.lisp:
+	(serve-request): Handle slime-read-errors and bind a
+	slime-toplevel catcher.
+
+	* swank-cmucl.lisp:
+	(sldb-loop): Flush output at the beginning.
+	(inspect-in-frame): New function.
+	(frame-locals): Don't send the validity indicator across wire.  Too
+	cmucl specific.
+
+2003-10-29  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-net-sentinel): Only show a message about
+	disconnection if the inferior-lisp is still running.
+	(slime-interrupt, slime-quit): Only send the quit/interrupt
+	message to Lisp if it is in fact evaluating something for us. This
+	fixes a protocol bug reported by Paolo Amoroso.  Added (require
+	'pp).
+
+2003-10-28  James Bielman  <jamesjb at jamesjb.com>
+
+	* null-swank-impl.lisp: New file.
+
+	* swank-openmcl.lisp: Pre-refactoring updates to the OpenMCL backend:
+	(map-backtrace): Renamed from DO-BACKTRACE.
+	(frame-source-location-for-emacs): New function.
+	(function-source-location-for-emacs): New function,
+
+	* swank-openmcl.lisp: Docstring updates/additions.
+
+2003-10-25  Luke Gorrie  <luke at bluetail.com>
+
+	* Everywhere: Changed the connection setup to use a dynamic
+	collision-free TCP port. The new protocol is this:
+	
+	  Emacs calls (swank:start-server FILENAME) via the
+	    listener. FILENAME is /tmp/slime.${emacspid}
+	  Lisp starts a TCP server on a dynamic available port and writes
+	    the port number it gets to FILENAME.
+	  Emacs asynchronously polls for FILENAME's creation. When it
+	    exists, Emacs reads the port number, deletes the file, and makes
+	    the connection.
+	
+	The advantage is that you can run multiple Emacsen each with an
+	inferior lisp, and the port numbers will never collide and Emacs
+	will always connect to the right lisp.
+
+	All backends are updated, but only CMUCL and SBCL are
+	tested. Therefore, OpenMCL is almost certainly broken just now.
+	
+	* slime.el (inferior-slime-closing-return): New command that
+	closes all open lists and sends the result to Lisp. Bound to C-RET
+	and (for people who use C-m for RET) C-M-m.
+	(inferior-slime-indent-line): Improved indentation in the inferior
+	list buffer.
+
+2003-10-24  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (inferior-slime-return): Command bound to RET in
+	inferior-slime-mode: only send the current input to Lisp if it is
+	a complete expression (or prefix argument is given). Two reasons:
+	it makes the input history contain complete expressions, and it
+	lets us nicely indent multiple-line inputs. (Thanks Raymond Toy
+	for the suggestions.)
+
+2003-10-23  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-maybe-start-lisp): Restart inferior-lisp if the
+	process has died.
+
+	* swank-sbcl.lisp (accept-connection): Use a character stream to
+	match swank.lisp.
+
+2003-10-22  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp (setup-request-handler): Create a character
+	stream.
+	(read-next-form): Removed.
+
+	* swank.lisp (read-next-form, send-to-emacs): Assume *emacs-io* is
+	a character stream. Add the necessary char-code/code-char
+	conversions.
+
+	* slime.el: slime-keys: Add :sldb keywords for keys useful in the
+	debugger.
+	(slime-init-keymaps): Allow allow :sldb keywords.
+
+	inferior-lisp-mode-hook: Display the inf-lisp buffer if there is
+	some output.
+
+	(slime-process-available-input): Start a timer to process any
+	remaining input.
+	(slime-dispatch-event): The timer should take care of any lost
+	input. So don't process the available input here.  Remove the
+	process-input argument.
+	(slime-push-state, slime-pop-state, slime-activate-state,
+	 slime-idle-state, slime-evaluating-state): Update callers.
+	(slime-debugging-state): Remove the unwind-protect in the
+	:debug-return clause.  Should not be necessary.
+
+	sldb-mode-map: Define more slime-mode keys.
+
+	(slime-time<, slime-time-add): Removed. Emacs-21 has equivalent time
+	functions.
+	(slime-sync-state-stack): Use Emacs-21 time-date functions.
+	(seconds-to-time, time-less-p, time-add): Compatibility defuns.
+
+2003-10-22  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime): With a prefix argument, prompt for the port
+	number to use for communication with Lisp. This is remembered for
+	future connections.
+
+2003-10-22  Hannu Koivisto  <azure at iki.fi>
+
+	* slime.el (slime-space): Now allows one to insert several spaces
+	with a prefix argument.
+
+2003-10-21  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-space): Don't give an error when not connected,
+	to avoid feeping.
+
+	* swank-sbcl.lisp (swank-compile-string): Include only one
+	:SOURCE-PATH attribute in the plist, and replace the front element
+	with a 0 (fixes a problem probably due to recent hacks to the
+	elisp source-path lookups).
+
+	* slime.el (inferior-slime-mode): New minor mode for use with
+	`inferior-lisp-mode'. Defines a subset of the `slime-mode' keys
+	which don't clash with comint (e.g. doesn't bind M-{p,n}).
+	(slime-keys): List of keybinding specifications.
+	(slime-find-buffer-package): If we don't find the "(in-package" by
+	searching backwards, then try forwards too.
+
+	* swank.lisp (completions): Fixed semantics: should now consider
+	only/all completions that would not cause a read-error due to
+	symbol visibility. Also avoiding duplicates and sorting on
+	symbol-name.
+
+2003-10-20  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (completions): Slight change of semantics: when a
+	prefix-designator is package-qualified, like "swank:", only match
+	symbols whose home-package matches the one given - ignore
+	inherited symbols.
+
+	* slime.el: Updated test suite to work with the different backends:
+	(find-definition): Lookup definitions in swank.lisp.
+	(arglist): Lookup arglists of functions in swank.lisp.
+
+2003-10-20  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (interactive-eval): Make test case independent of
+	*print-case*.
+
+2003-10-20  Luke Gorrie  <luke at bluetail.com>
+
+	* swank-cmucl.lisp (clear-xref-info): Conditionalised
+	xref:*who-is-called* and xref:*who-macroexpands* with
+	#+CMU19. This makes SLIME compatible with CMUCL 18e, but also
+	disables the `who-macroexpands' command in any CMUCL version that
+	doesn't have the "19A" feature (which does break the command in
+	some snapshot builds that can actually support it).
+
+2003-10-20  Daniel Barlow  <dan at telent.net>
+
+	* swank.lisp (*notes-database*): tyop fix
+
+	* swank-sbcl.lisp (throw-to-toplevel): select TOPLEVEL restart
+	instead of throwing to a catch that no longer exists
+
+	* slime.el: change some strings containing 'CMUCL' to more 
+        backend-agnostic phrases
+
+2003-10-19  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el, swank-cmucl.lisp, swank.lisp: First shoot at input
+	redirection.
+
+	* swank-sbcl.lisp, swank-openmcl.lisp: Bind *slime-input* and
+	*slime-io* to dummy values.
+
+2003-10-19  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime): Connection setup is now asynchronous, with
+	retrying on a timer. This makes it possible to bring the server up
+	by hand while debugging. `M-x slime' while already connected will
+	cause the old connection to be dropped and a new one established.
+	(slime-disconnect): New command to disconnect from Swank, or
+	cancel asynchronous connection attempts when not yet connected.
+	(slime-state/event-panic): Illegal events in the communication
+	state machine now trigger a general panic that disconnects from
+	Lisp, and displays a message describing what has happened. This is
+	a bug situation.
+	(slime-connect): Print a message during connection attempts unless
+	the minibuffer is active (it's annoying to get messages while
+	trying to enter commands).
+
+2003-10-18  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Fix some bugs in the state machine and be a bit more
+	careful when processing pending input.
+	(slime-compile-region): New command.
+	Some more tests.
+	
+2003-10-17  James Bielman  <jamesjb at jamesjb.com>
+
+	* .cvsignore: Add OpenMCL and SBCL fasl file extensions.
+
+	* swank-openmcl.lisp (who-calls): Fix bug where we would try to
+	take the TRUENAME of NIL when source information isn't available
+	for a caller.
+	(backtrace-for-emacs): Clean up the backtrace code a bit in 
+	preparation for implementing FRAME-LOCALS.
+	(frame-catch-tags): Implement a stub version of this.
+	(frame-locals): Implemented fully for OpenMCL.
+
+	* swank-loader.lisp (compile-files-if-needed-serially): Be a little
+	more verbose when compiling files.
+
+2003-10-17  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp, swank-sbcl.lisp, swank-openmcl.lisp,
+	swank-cmucl.lisp: Move more stuff to swank.lisp.
+	
+2003-10-17  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-post-command-hook): Check that we are connected
+	before trying to process input.
+	(slime-net-connect): Handle `network-error' condition for XEmacs
+	21.5. (Thanks Raymond Toy.)
+
+	* swank-sbcl.lisp: Report style-warnings separately from notes
+	(patch from Christophe Rhodes). Use REQUIRE to load sb-introspect
+	instead of loading the source file (requires the sb-introspect
+	library to be installed, which doesn't yet happen in the
+	sourceforge-lagged SBCL anoncvs, but does in the real one).
+
+	* slime.el (slime-style-warning-face): Added style-warnings, which
+	are between a warning and a note in severity. (Patch from
+	Christophe Rhodes).
+
+	* test.sh: When the test fails to complete, print "crashed"
+	instead of reporting nonsense.
+
+2003-10-17  James Bielman  <jamesjb at jamesjb.com>
+
+	* swank.lisp (apropos-symbols): Change back to using the standard
+	2-argument APROPOS-LIST and check symbols explicitly when
+	EXTERNAL-ONLY is true.
+	Move loading of sys-dependent backend code into 'swank-loader'.
+
+	* swank-sbcl.lisp: Moved declarations of *PREVIOUS-COMPILER-CONDITION*
+	into 'swank.lisp' to kill warnings about undefined variables.
+
+	* swank-openmcl.lisp (handle-compiler-warning): Use source position
+	instead of function name for warning locations.
+	(swank-compile-string): Compile into a temporary file instead of
+	using COMPILE so finding warning positions works when using C-c C-c.
+	(compute-backtrace): Don't display frames without a function.
+	(apropos-list-for-emacs): Implement APROPOS.
+	(who-calls): Implement WHO-CALLS.
+	(completions): Implement COMPLETIONS.
+	Use NIL instead of zero so FRESH-LINE does the right thing.
+
+	* slime.el (slime-maybe-compile-swank): Removed function---compile
+	the backend using 'swank-loader.lisp' instead.
+	(slime-backend): Changed default backend to 'slime-loader'.
+	(slime-lisp-binary-extension): Deleted as this is no longer needed.
+
+	* swank-loader.lisp: New file.
+
+2003-10-17  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-net-connect): Check that
+	`set-process-coding-system' is fbound before calling it. This is
+	needed in the XEmacs I built from sources.
+
+2003-10-17  Daniel Barlow  <dan at telent.net>
+
+	* swank-sbcl.lisp: Transplanted Helmut's serve-event server to
+	replace the existing thread-using server.  SLIME now has no 
+	dependency on SB-THREAD
+
+	* slime.el (slime-find-buffer-package): handle errors from (read)
+	for the case where the buffer ends before the in-package form does
+	(slime-set-package): insert missing comma
+	(slime-goto-source-location): sbcl has a disagreement with emacs
+	over the meaning of a character position.  Level up with
+	C-M-f C-M-b
+
+	* assorted typo fixes
+
+2003-10-16  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-forward-source-path): Improved somewhat. Seems
+	to work for all common cases except backquote. Backquote is
+	tricky, because the source-paths are based on the reader's
+	expansion, e.g.:
+	* (let ((*print-pretty* nil))
+	    (print (read-from-string "`(a ,@(b c) d)")))
+	  -->
+	  (COMMON-LISP::BACKQ-CONS (QUOTE A)
+	                           (COMMON-LISP::BACKQ-APPEND (B C)
+			                                      (QUOTE (D))))
+	Must investigate whether we need to write a hairy
+	backquote-traversing state machine or whether this is something
+	that could be fixed in CMUCL.
+
+	* swank*.lisp (with-trapping-compiler-notes): This macro is now
+	defined here, and expands to a call to the backend-defined
+	`call-trapping-compiler-notes' with the body wrapped in a
+	lambda. This is to avoid swank.lisp referring to macros in the
+	backends -- it gets compiled first so it thinks they're functions.
+
+	* slime.el (slime-swank-connection-retries): New default value is
+	`nil', which means unlimited retries (until user aborts). Retry
+	interval also reduced from once per second to four times per
+	second.
+
+2003-10-16  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank-cmucl.lisp, swank.lisp: Fix CMUCL support. 
+
+2003-10-15  Daniel Barlow  <dan at telent.net>
+
+	* swank.lisp: rearrange the backends.  rename swank.lisp to
+	swank-cmucl.lisp, then create new swank.lisp which loads an
+	appropriate backend according to *features*.  Next up, 
+	identify common functions in the backends and move them
+	into swank.lisp
+
+2003-10-15  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Inspector support.  list-callers, list-callees
+	implemented without xref.
+
+	* swank.lisp: Lisp side for inspector and list-callers,
+	list-calees.  Better fdefinition finding for struct-accessors.
+
+
+2003-10-15  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-point-moves-p): Macro for executing subforms and
+	returning true if they move the point.
+
+	* test.sh: New file to run the test suite in batch-mode. Will need
+	a little extending to allow configuring the right variables to
+	work with non-CMUCL backends.
+
+	* slime.el: Set `indent-tabs-mode' to nil. This makes diffs look
+	better.
+	(slime-start-swank-server): Now passing the port number to
+	SWANK:START-SERVER.
+	(slime-evaluating-state): Debugging synchronous evaluations with
+	recursive edits now works.
+	(slime-forward-sexp): Added support for #|...|# reader comments.
+	(sldb-hook): New hook for entry to the debugger (used for the test
+	suite).
+	(slime-run-tests): Reworked the testing framework. Now presents
+	results in an outline-mode buffer, with only the subtrees
+	containing failed tests expanded initially.
+	(slime-check): Check-name can now be a string or
+	format-control. (Test cases have been updated to take advantage of
+	this.)
+	(compile-defun): This test case now works for the case containing
+	#|..|#
+	(async-eval-debugging): New test case for recursively debugging
+	asynchronous evaluation.
+
+2003-10-15  Daniel Barlow  <dan at telent.net>
+
+	* README.sbcl: new file
+
+	* README: update for new backends, change of hosting provider
+
+	* swank-sbcl.lisp: new file.
+	New SWANK backend for Steel Bank Common Lisp, adapted from
+	swank.lisp with bits of swank-openmcl.lisp
+
+2003-10-12  Daniel Barlow  <dan at telent.net>
+
+	* slime.el (sldb-mode-map): add mouse-2 clickability for areas
+	in sldb buffers covered by the sldb-default-action property:
+	restarts can now be mouse-activated
+
+2003-09-28  James Bielman  <jamesjb at jamesjb.com>
+
+	* swank-openmcl.lisp: New file, a Slime backend for OpenMCL 0.14.x.
+	(condition-function-name): Figure out the name of methods correctly
+	instead of passing a list to Emacs.
+
+	* slime.el (slime-goto-location): Try to position notes based on
+	some (questionable) regex searching if the :FUNCTION-NAME property
+	is set.  Used in the OpenMCL backend which does not support source
+	paths.
+
+2003-09-29  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Fairly major hacking.
+	Rewrote the evaluation mechanics: similar design but some macros
+	to make it look more like a push-down automaton (which it really
+	was!). Debugging Lisp no longer uses recursive edits, partly as a
+	side-effect and partly to see if it's better this way.
+	Removed the asynchronous-communication test cases that tested
+	something we decided not to do.
+	(slime-eval-string-async): Give a meaningful error message when
+	trying to make a request while already busy.
+	(slime-lisp-binary-extension): Uh oh, time to start taking out
+	gratuitous CMUCL-isms. This variable renamed from
+	`slime-cmucl-binary-extension'.
+	(slime-backend): Name of the Lisp backend file, defaulting to
+	"swank", but can be set to e.g. "swank-openmcl".
+
+	* swank.lisp: Minor protocol changes to accomodate slime.el's
+	changes above.
+
+2003-09-28  Helmut Eller  <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp 
+	(getpid, set-package, set-default-directory): New functions.
+	(slime-out-misc): Don't send empty strings.
+	(*redirect-output*, read-from-emacs): A new switch to turn output
+	redirection off. Useful for debugging.
+	(interactive-eval, interactive-eval-region, pprint-eval,
+	re-evaluate-defvar): Bind *package* to *buffer-package*.
+	(with-trapping-compilation-notes): Add a dummy argument for better
+	indentation.
+	(measure-time-intervall, call-with-compilation-hooks): Measure
+	compilation time.
+	(frame-locals): Use di::debug-function-debug-variables instead of
+	di:ambiguous-debug-variables. Don't access non-valid variables.
+
+	* slime.el
+	(slime-display-message-or-view): Delete old multi-line windows.
+	(slime-read-package-name): Added an optional initial-value
+	argument.  slime-pid: New variable.
+	(slime-init-dispatcher): Initialize slime-pid.
+	(slime-send-sigint): Use slime-pid instead of inferior-lisp-proc.
+	(slime-eval): Accept debug-condition messages.
+	(slime-output-buffer): Turn slime-mode on.
+	(slime-switch-to-output-buffer): New command.  Bound to C-c C-z.
+	(slime-show-note-counts): Display compilation time.
+	(slime-untrace-all, slime-set-package, slime-set-default-directory
+	slime-sync-package-and-default-directory): New commands.
+	(slime-princ-locals): Don't access non-valid variables.  This may
+	cause segfaults and severely confuse CMUCL.
+	(slime-define-keys): New macro.
+
+2003-09-28  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (create-swank-server): Bind the listen-socket on the
+	loopback interface by default, so that remote machines can't
+	connect to the Swank server.
+
+2003-09-27  Luke Gorrie  <luke at bluetail.com>
+
+	* swank.lisp (with-trapping-compilation-notes): New macro for
+	bindings the handlers to record compiler notes. Now being used in
+	`compile-string', which I had broken when removing the compilation
+	hook.
+
+	* slime.el (slime-function-called-at-point): Rewritten to work
+	better. Now considers "((foo ..." _not_ to be a function call to
+	foo because of the double ('s - this will keep it from misfiring
+	in e.g. LET bindings.
+	(def-slime-test): All tests now being with (slime-sync). This
+	fixes some accidental/bogus test failures.
+
+	* swank.lisp (handle-notification-condition): Rewrote
+	compiler-note collection. Now it uses lower-level condition
+	handlers instead of c:*compiler-notification-function*. This way
+	the error messages are tailored to omit redundant information,
+	like the filename and original source text (which are displayed
+	and highlighted in Emacs already). Much nicer.
+	(sort-contexts-by-source-path): Now sorting xref results by
+	lexical source-path order, so that you're always jumping in the
+	same direction.
+	(*debug-definition-finding*): New variable. You can set this to
+	true if you want to be popped into the debugger when M-. fails to
+	find a definition (for debugging the
+	definition-finding). Otherwise it reports the error to Emacs as a
+	message, like "Error: SETQ is a special form."
+
+	* slime.el (slime-fetch-features-list): New command to fetch the
+	*FEATURES* list from Lisp and store it away. This is done
+	automatically upon connection, but can also be called manually to
+	update.
+	(slime-forward-reader-conditional): Now does the right things with
+	reader-conditionals (#+ and #-) based on the Lisp features.
+
+2003-09-26  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (sldb-setup): Setting `truncate-lines' to t in the
+	debug buffer. I like having the backtrace take strictly one line
+	per frame, since otherwise a few ugly arguments (e.g. streams) can
+	chew up a lot of space. (Can make this a configurable on request
+	if tastes differ :-)
+
+	* swank.lisp: Did a little defensive programming so that asking
+	for the definition of an unbound function will return nil to Emacs
+	instead of entering the debugger.
+	(format-frame-for-emacs): Binding *PRETTY-PRINT* to nil when
+	formatting frames (due to truncate-lines change above).
+
+2003-09-24  Helmut Eller <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp:
+	Support for stream redirection.
+	slime-output-stream: New structure.
+	(slime-out-misc): New function.
+	*slime-output*: New variable.
+	(read-from-emacs): Redirect output to *slime-output*.
+	(read-form): Bind *package* inside the standard-io-syntax macro.
+	(eval-string): Read the string with read-form.
+	(completions): Support for keyword completion.
+
+	* slime.el (slime-process-available-input, slime-eval): Rewritten
+	once again.  Don't use unwind-protect anymore. Didn't work
+	properly when the Lisp side aborted due to too many debug
+	levels. "Continuing" from the Emacs debugger aborts one level on
+	the Lisp side. "Quitting" from the Emacs debugger quits the Lisp
+	side too. Increase stack sizes before entering the recursive edit.
+	(slime-eval-async-state, slime-eval, sldb-state): Support for stream
+	output.
+	slime-last-output-start: New variable.
+	(slime-output-buffer, slime-output-buffer-position,
+	 slime-insert-transcript-delimiter, slime-show-last-output,
+	 slime-output-string): New functions.
+	(slime-show-evaluation-result,
+	slime-show-evaluation-result-continuation): Use them.
+	(slime-use-inf-lisp-p, slime-insert-transcript-delimiter,
+	 slime-inferior-lisp-marker-position,
+	 slime-inferior-lisp-show-last-output): Deleted.
+	(slime-use-tty-debugger, slime-debugger-hook,
+	slime-enter-tty-debugger, slime-tty-debugger-state): Deleted. Removed
+	tty debugger support.
+	(def-sldb-invoke-restart): Renamed.
+	(define-sldb-invoke-restart-key, define-sldb-invoke-restart-keys):
+	Version without eval.
+	(defun-if-undefined): New macro.
+	Many indentation fixes.
+
+2003-09-23  Helmut Eller <e9626484 at stud3.tuwien.ac.at>
+
+	* swank.lisp (completions):
+	Moved most of the completion code to Lisp.
+	(string-prefix-p): Be case insensitive.
+
+	* slime.el:
+	Make sure define-minor-mode is defined before we use it.
+	(slime-completing-read-internal, slime-completing-read-symbol-name,
+	slime-read-from-minibuffer, slime-completions, slime-complete-symbol):
+	Support for reading symbols and expressions with completion.
+	(slime-read-symbol-name): New function.
+	(slime-read-symbol): Use it.
+	(slime-read-package-name): Case insensitive completion.
+
+	(slime-edit-symbol-fdefinition, slime-edit-fdefinition): Rename
+	slime-edit-symbol-fdefinition to slime-edit-fdefinition.
+
+2003-09-23  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-show-xrefs): Improved the xrefs buffer, now
+	using a custom minor mode.
+	(slime-next-location): This function goes to the next "something"
+	by funcall'ing slime-next-location-function. Currently that
+	variable is set by xref commands like who-calls to go to the next
+	matching reference. In future it can also be used to go to the
+	next function definition for a generic-function-understanding
+	version of edit-fdefinition. Bound to C-M-. and C-c C-SPC, until
+	we see which binding is better.
+
+2003-09-22  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-symbol-at-point): Now returns a symbol, as the
+	name suggests.
+	(slime-symbol-name-at-point): This one returns a string.
+	(slime-read-symbol): New function for taking the symbol at point,
+	or prompting if there isn't one.
+	(slime-edit-fdefinition): Now uses looks up the symbol at point,
+	not the function being called at point.
+
+	* swank.lisp (who-calls, who-references, who-binds, who-sets,
+	who-macroexpands): New function.
+	(present-symbol-before-p): Use `*buffer-package*' when checking
+	accessibility of symbols.
+
+	* slime.el (slime-restore-window-configuration): New command to
+	put the Emacs window configuration back the way it was before
+	SLIME last changed it.
+	(slime-who-calls, etc): Very basic WHO-{CALLS,..} support. Not
+	finished, wrestling around trying to make `view-mode' or
+	`help-mode' help me (I just want to hijack RET and C-m). Bound to
+	"C-c C-w ...".
+
+2003-09-21  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el: Rearranged the `outline-mode' structure slightly.
+	(slime-check-connected): Using new function to give a helpful
+	error message if you try to use commands before establishing a
+	connection to CMUCL.
+	(sldb-mode): Keys 0-9 are now shortcuts to invoke restarts.
+
+	* README, swank.el: Updated commentary.
+
+2003-09-20  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-choose-overlay-region): Tweaked overlay
+	placement.
+
+	* swank.lisp (handle-notification): Skipping null
+	notifications. For some reason CMUCL occasionally calls us with
+	NIL as each argument.
+
+2003-09-19  Helmut Eller <e9626484 at stud3.tuwien.ac.at>
+	
+	* slime.el (slime-connect): Propose default values when called
+	interactively.
+	(slime-process-available-input): If possible, use while rather than
+	recursion.
+	(slime-compilation-finished-continuation): New function.
+	(slime-compile-file, slime-compile-defun): Use it.
+	(slime-forward-source-path): Id an error is encounter move back to the
+	last valid point.
+	(slime-eval-region): Use append COND.  Send the entire string to the
+	Lisp side and read&evaluate it there.
+	(slime-eval-buffer): New function.
+	(sldb-sugar-move, sldb-details-up, sldb-details-down): New functions.
+	
+	* swank.lisp (interactive-eval-region): New function.
+	(re-evaluate-defvar): New function.
+	(compile-defun): Install handler for compiler-errors.
+	(function-first-code-location): Simplified.
+	
+2003-09-17  Helmut Eller <e9626484 at stud3.tuwien.ac.at>
+	
+	* slime.el (slime-apropos-all): New command, bound to C-c M-a.
+	(slime-eval): Simplified.
+	(swank:arglist-string): Send a string and not a symbol.  It easier
+	to package related thins in CL.
+	(slime-edit-symbol-fdefinition): Prompt when called with
+	prefix-argument.
+	(slime-eval-region): New function.
+	(slime-load-file): New function.
+	(slime-show-description): Set slime minor mode in Help buffer.
+
+	* swank.lisp: (read-string, from-string): Renamed read-string to
+	from-string.
+	(to-string) New function.
+	(arglist-string): Catch reader errors.
+	(sldb-loop): Also bind *readstrable*.
+
+	
+2003-09-16  Helmut Eller <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el (slime-toggle-trace-fdefinition): New command.
+	(slime-symbol-at-point, slime-sexp-at-point): New utility functions.
+	(slime-edit-symbol-fdefinition): Similar to slime-edit-fdefinition but
+	uses swank:function-source-location-for-emacs.
+	(slime-goto-source-location): New function.
+	(sldb-show-source): Use it.
+	(slime-read-package-name): Completing read for package names.
+	(slime-apropos): Use it.
+
+	* swank.lisp (function-source-location,
+	function-source-location-for-emacs): New functions to extract
+	source locations from compiled code.  For struct-accessors we try
+	to find the source location of the corresponding constructor.
+	(list-all-package-names): New function.
+	(toggle-trace-fdefinition, tracedp): New functions.
+
+2003-09-15  Helmut Eller <e9626484 at stud3.tuwien.ac.at>
+
+	* slime.el: Moved many CL fragments from slime.el to swank.lisp.
+	(slime-compile-file, slime-compile-defun, slime-goto-location):
+	Compiler notes are now represented with a property list.  To find
+	the source expression first move to the file offset of the
+	top-level form and then use the source path to find the
+	expression.  This should avoid many reader issues.  For
+	compile-defun store the start position of the top-level expression
+	from the buffer in the compiler notes and use that to locate error
+	messages.  Add error overlays for notes without context to the
+	first available expression.
+
+	* swank.lisp: Moved many CL fragments from slime.el to swank.lisp.
+	(defslimefun): New macro.
+
+2003-09-15  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-setup-command-hooks): Removed post-command-hook
+	that was used for cleaning up input that was unprocessed due to an
+	error breaking out of the process filter. This is now handled by
+	an `unwind-protect' in the filter.
+
+	* swank.lisp (apropos-list-for-emacs): Hacked the apropos listing
+	to accept more options and to specially sort results.
+
+	* slime.el (slime-net-send): Added newlines to messages over the
+	wire. This makes the protocol nicely readable in Ethereal.
+	(slime-sync): New function for blocking until asynchronous
+	requests are complete.
+	(slime-apropos): Hacked the apropos command: by default, only
+	external symbols are shown. With a prefix argument you have the
+	option to include internal symbols and to specify a package.
+	(slime-run-tests): Extended the test suite. Use `M-x
+	slime-run-tests' to run it.
+
+2003-09-14  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el, swank.lisp: Added the debugger written by Helmut.
+
+	* cmucl-wire.el: Removed. The WIRE communication protocol has been
+	replaced by a simple custom TCP protocol based on READ/PRIN1 to
+	send sexps as ascii text. This simplifies the code, makes the
+	protocol nicely debugable with ethereal, and should ease porting
+	to other Lisps. Incremented TCP port number to 4005 in honor of
+	the new protocol.
+	
+	In addition, Lisp now always uses *print-case* of :DOWNCASE when
+	preparing sexps for Emacs. This is in reaction to a bug with Emacs
+	reading the empty list as `NIL' instead of `nil'.
+
+	* slime.el (slime-net-connect): The Emacs end of the new
+	communication protocol.
+
+	* swank.lisp (create-swank-server): The Lisp end of the new
+	communication protocol.
+
+2003-09-11  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-mode): Added Helmut's commands to the mode
+	description.
+	(slime-show-apropos): Setting `truncate-lines' to t in apropos
+	listings, to avoid line-wrapping on overly long descriptions.
+	(slime-run-tests): Added the beginnings of an automated test
+	suite. (This is most useful for testing cross-Emacsen
+	compatibility before releases.)
+
+	* swank.lisp (symbol-external-p): Put back this function which was
+	lost in a merge.
+
+2003-09-10  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el, cmucl-wire.el, swank.lisp: Large patch from Helmut
+	Eller. Includes: apropos, describe, compile-defun, fully
+	asynchronous continuation-based wire interface, interactive
+	evaluation, and more. Very nice :-)
+
+2003-09-08  Luke Gorrie  <luke at bluetail.com>
+
+	* cmucl-wire.el (wire-symbol-name, wire-symbol-package): Fixed to
+	handle internal references (pkg::name).
+
+	* slime.el (slime-swank-connection-retries): Increased default
+	number of connection retries from 5 to ten.
+
+	* swank.lisp (find-fdefinition): Support for finding
+	function/macro definitions for Emacs.
+
+	* slime.el: Indentation "cleanups": somehow I was using
+	`common-lisp-indent-function' for Emacs Lisp code previously.
+	(slime-edit-fdefinition): Added M-. (edit definition) and M-, (pop
+	definition stack) commands. Definitions are found in much the same
+	way Hemlock does it. The user-interface is not the same as TAGS,
+	because I like this one better. We can add TAGS-compatibility as
+	an optional feature in future.
+
+2003-09-04  Luke Gorrie  <luke at bluetail.com>
+
+	* slime.el (slime-completions): Now supports completing
+	package-internal symbols with "pkg::prefix" syntax.
+
+	* Everything: imported slime-0.2 sources.
+
+;; Local Variables:
+;; coding: latin-1
+;; End:
+
+This file has been placed in the public domain.

Added: branches/trunk-reorg/thirdparty/slime/HACKING
===================================================================
--- branches/trunk-reorg/thirdparty/slime/HACKING	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/HACKING	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,136 @@
+* The SLIME Hacker's Handbook                                   -*- outline -*-
+
+* Lisp code file structure
+
+The Lisp code is organised into these files:
+
+  swank-backend.lisp:
+    Definition of the interface to non-portable features.
+    Stand-alone.
+
+  swank-<cmucl|...>.lisp:
+    Backend implementation for a specific Common Lisp system.
+    Uses swank-backend.lisp.
+
+  swank.lisp:
+    The top-level server program, built from the other components.
+    Uses swank-backend.lisp as an interface to the actual backends.
+
+* ChangeLog
+
+For each change we make an entry in the ChangeLog file. This is
+typically done using the command `add-change-log-entry-other-window'
+(C-x 4 a). The message can be automatically extracted from the
+ChangeLog to use in a CVS commit message by pressing C-c C-a in a
+vc-mode or pcl-cvs commit buffer.
+
+ChangeLog diffs are automatically sent to the slime-devel mailing list
+each day as a sort of digest summary of the slime-cvs list.
+
+There are good tips on writing ChangeLog entries in the GNU Coding Standards:
+  http://www.gnu.org/prep/standards_40.html#SEC40
+
+For information about Emacs's ChangeLog support see the `Change Log'
+and `Change Logs and VC' nodes of the Emacs manual:
+  http://www.gnu.org/software/emacs/manual/html_node/emacs_333.html#SEC333
+  http://www.gnu.org/software/emacs/manual/html_node/emacs_156.html#SEC156
+
+* Sending Patches
+
+If you would like to send us improvements you can create a patch with
+C-x v = in the buffer or manually with 'cvs diff -u'.  It's helpful if
+you also include a ChangeLog entry describing your change.
+
+* Test Suite
+
+The Elisp code includes a command `slime-run-tests' to run a test
+suite. This can give a pretty good sanity-check for your changes.
+
+Some backends do not pass the full test suite because of missing
+features. In these cases the test suite is still useful to ensure that
+changes don't introduce new errors. CMUCL historically passes the full
+test suite so it makes a good sanity check for fundamental changes
+(e.g. to the protocol).
+
+Running the test suite, adding new cases, and increasing the number of
+cases that backends support are all very good for karma.
+
+
+* Source code layout
+
+We use a special source file layout to take advantage of some fancy
+Emacs features: outline-mode and "narrowing".
+
+** Outline structure
+
+Our source files have a hierarchical structure using comments like
+these:
+
+  ;;;; Heading
+  ;;;;; Subheading
+  ... etc
+
+We do this as a nice way to structure the program. We try to keep each
+(sub)section small enough to fit in your head: typically around 50-200
+lines of code each. Each section usually begins with a brief
+introduction, followed by its highest-level functions, followed by
+their subroutines. This is a pleasing shape for a source file to have.
+
+Of course the comments mean something to Emacs too. One handy usage is
+to bring up a hyperlinked "table of contents" for the source file
+using this command:
+
+  (defun show-outline-structure ()
+    "Show the outline-mode structure of the current buffer."
+    (interactive)
+    (occur (concat "^" outline-regexp)))
+
+Another is to use `outline-minor-mode' to fold away certain parts of
+the buffer. See the `Outline Mode' section of the Emacs manual for
+details about that.
+
+(This file is also formatted for outline mode. If you're reading in
+Emacs you can play around e.g. by pressing `C-c C-d' right now.)
+
+** Pagebreak characters (^L)
+
+We partition source files into chunks using pagebreak characters. Each
+chunk is a substantial piece of code that can be considered in
+isolation, that could perhaps be a separate source file if we were
+fanatical about small source files (rather than big ones!)
+
+The page breaks usually go in the same place as top-level outline-mode
+headings, but they don't have to. They're flexible.
+
+In the old days, when slime.el was less than 100 pages long, these
+page breaks were helpful when printing it out to read. Now they're
+useful for something else: narrowing.
+
+You can use `C-x n p' (narrow-to-page) to "zoom in" on a
+pagebreak-delimited section of the file as if it were a separate
+buffer in itself. You can then use `C-x n w' (widen) to "zoom out" and
+see the whole file again. This is tremendously helpful for focusing
+your attention on one part of the program as if it were its own file.
+
+(This file contains some page break characters. If you're reading in
+Emacs you can press `C-x n p' to narrow to this page, and then later
+`C-x n w' to make the whole buffer visible again.)
+
+
+* Coding style
+
+We like the fact that each function in SLIME will fit on a single
+screen (80x20), and would like to preserve this property! Beyond that
+we're not dogmatic :-)
+
+In early discussions we all made happy noises about the advice in
+Norvig and Pitman's _Tutorial on Good Lisp Programming Style_:
+  http://www.norvig.com/luv-slides.ps
+
+For Emacs Lisp, we try to follow the _Tips and Conventions_ in
+Appendix D of the GNU Emacs Lisp Reference Manual (see Info file
+`elisp', node `Tips').
+
+Remember that to rewrite a program better is the sincerest form of
+code appreciation. When you can see a way to rewrite a part of SLIME
+better, please do so!

Added: branches/trunk-reorg/thirdparty/slime/NEWS
===================================================================
--- branches/trunk-reorg/thirdparty/slime/NEWS	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/NEWS	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,110 @@
+* SLIME News                  -*- outline -*-
+
+* 1.2 (March 2005)
+
+** New inspector
+The lisp side now returns a specially formated list of "things" to
+format which are then passed to emacs and rendered in the inspector
+buffer. Things can be either text, recursivly inspectable values, or
+functions to call. The new inspector has much better support CLOS
+objects and methods.
+
+** Unicode
+It's now possible to send non-ascii characters to Emacs, if the
+communication channel is configured properly.  See the variable
+`slime-net-coding-system'.
+
+** Arglist lookup while debugging
+Previously, arglist lookup was disabled while debugging.  This
+restriction was removed. 
+
+** Extended tracing command
+It's now possible to trace individual a single methods or all methods
+of a generic function.  Also tracing can be restricted to situations
+in which the traced function is called from a specific function.
+
+** M-x slime-browse-classes
+A simple class browser was added.
+
+** FASL files
+The fasl files for different Lisp/OS/hardware combinations are now
+placed in different directories.
+
+** Many other small improvements and bugfixes
+
+* 1.0 (September 2004)
+
+** slime-interrupt
+The default key binding for slime-interrupt is now C-c C-b.
+
+** sldb-inspect-condition
+In SLDB 'C' is now bound to sldb-inspect-condition.
+
+** More Menus
+SLDB and the REPL have now pull-down menus.
+
+** Global debugger hook.
+A new configurable *global-debugger* to control whether
+swank-debugger-hook should be installed globally is available. True by
+default.
+
+** When you call sldb-eval-in-frame with a prefix argument, the result is 
+now inserted in the REPL buffer.
+
+** Compile function
+For Allegro M-. works now for functions compiled with C-c C-c.
+
+** slime-edit-definition
+Better support for Allegro: works now for different type of
+definitions not only. So M-. now works for e.g. classes in Allegro.
+
+** SBCL 0.8.13
+SBCL 0.8.12 is no longer supported.  Support for 0.8.12 was broken for
+for some time now.
+
+* 1.0 beta (August 2004)
+
+** autodoc global variables
+The slime-autodoc-mode will now automatically show the value of a
+global variable at point.
+
+** Customize group
+The customize group is expanded and better-organised.
+
+** slime-interactive-eval
+Interactive-eval commands now print their results to the REPL when
+given a prefix argument.
+
+** slime-conservative-indentation
+New Elisp variable. Non-nil means that we exclude def* and with-* from
+indentation-learning. The default is t.
+
+** (slime-setup)
+New function to streamline setup in ~/.emacs
+
+** Modeline package
+The package name in the modeline is now updated on an idle timer. The
+message should now be more meaningful when moving around in files
+containing multiple IN-PACKAGE forms.
+
+** XREF bugfix
+The XREF commands did not find symbols in the right package.
+
+** REPL prompt
+The package name in the REPL's prompt is now abbreviated to the last
+`.'-delimited token, e.g. MY.COMPANY.PACKAGE would be PACKAGE. This
+can be disabled by setting SWANK::*AUTO-ABBREVIATE-DOTTED-PACKAGES* to
+NIL.
+
+** CMUCL source cache
+The source cache is now populated on `first-change-hook'. This makes
+M-. work accurately in more file modification scenarios.
+
+** SBCL compiler errors
+Detect compiler errors and make some noise. Previously certain
+problems (e.g. reader-errors) could slip by quietly.
+
+* 1.0 alpha (June 2004)
+
+The first preview release of SLIME.
+

Added: branches/trunk-reorg/thirdparty/slime/PROBLEMS
===================================================================
--- branches/trunk-reorg/thirdparty/slime/PROBLEMS	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/PROBLEMS	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,95 @@
+Known problems with SLIME                                   -*- outline -*-
+
+* Common to all backends
+
+** Caution: network security
+The `M-x slime' command has Lisp listen on a TCP socket and wait for
+Emacs to connect, which typically takes on the order of one second. If
+someone else were to connect to this socket then they could use the
+SLIME protocol to control the Lisp process.
+
+The listen socket is bound on the loopback interface in all Lisps that
+support this. This way remote hosts are unable to connect.
+
+** READ-CHAR-NO-HANG is broken
+
+READ-CHAR-NO-HANG doesn't work properly for slime-input-streams.  Due
+to the way we request input from Emacs it's not possible to repeatedly
+poll for input.  To get any input you have to call READ-CHAR (or a
+function which calls READ-CHAR).
+
+* Backend-specific problems
+
+** CMUCL
+
+The default communication style :SIGIO is reportedly unreliable with
+certain libraries (like libSDL) and certain platforms (like Solaris on
+Sparc). It generally works very well on x86 so it remains the default.
+
+** SBCL
+
+The latest released version of SBCL at the time of packaging should
+work.  Older or newer SBCLs may or may not work.  Do not use
+multithreading with unpatched 2.4 Linux kernels.  There are also
+problems with kernel versions 2.6.5 - 2.6.10.
+
+The (v)iew-source command in the debugger can only locate exact source
+forms for code compiled at (debug 2) or higher. The default level is
+lower and SBCL itself is compiled at a lower setting. Thus only
+defun-granularity is available with default policies.
+
+The XREF commands are not implemented.
+
+** OpenMCL
+
+We support OpenMCL 0.14.3.
+
+The XREF commands are not available.
+
+** LispWorks
+
+On Windows, SLIME hangs when calling foreign functions or certain
+other functions.  The reason for this problem is unknown.
+
+We only support latin1 encoding.  (Unicode wouldn't be hard to add.)
+
+** Allegro CL
+
+Interrupting Allegro with C-c C-b can be slow.  This is caused by the
+a relatively large process-quantum: 2 seconds by default.  Allegro
+responds much faster if mp:*default-process-quantum* is set to 0.1.
+
+** CLISP
+
+We require version 2.33.2 or higher. We also require socket support, so
+you may have to start CLISP with "clisp -K full".
+
+Under Windows, interrupting (with C-c C-b) doesn't work.  Emacs sends
+a SIGINT signal, but the signal is either ignored or CLISP exits
+immediately.
+
+Function arguments and local variables aren't displayed properly in
+the backtrace.  Changes to CLISP's C code are needed to fix this
+problem.  Interpreted code is usually easer to debug.
+
+M-. (find-definition) only works if the fasl file is in the same
+directory as the source file.
+
+The arglist doesn't include the proper names only "fake symbols" like
+`arg1'.
+
+** Armed Bear Common Lisp
+
+The ABCL support is still new and experimental.
+
+** Corman Common Lisp
+
+We require version 2.51 or higher, with several patches (available at
+http://www.grumblesmurf.org/lisp/corman-patches).
+
+The only communication style currently supported is NIL.
+
+Interrupting (with C-c C-b) doesn't work.
+
+The tracing, stepping and XREF commands are not implemented along with
+some debugger functionality.

Added: branches/trunk-reorg/thirdparty/slime/README
===================================================================
--- branches/trunk-reorg/thirdparty/slime/README	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/README	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,41 @@
+Overview.
+----------------------------------------
+
+  SLIME is the Superior Lisp Interaction Mode for Emacs. It is
+  implemented in two main parts: the Emacs Lisp side (slime.el), and
+  the support library for the Common Lisp (swank.lisp and swank-*.lisp)
+
+  For a real description, see the manual in doc/
+
+Quick setup instructions
+------------------------
+
+  Add this to your ~/.emacs file and fill in the appropriate filenames:
+
+    (add-to-list 'load-path "~/hacking/lisp/slime/")  ; your SLIME directory
+    (setq inferior-lisp-program "/opt/sbcl/bin/sbcl") ; your Lisp system
+    (require 'slime)
+    (slime-setup)
+
+  Make sure your `inferior-lisp-program' is set to a compatible
+  version of Lisp.
+
+  Use `M-x' slime to fire up and connect to an inferior Lisp.
+  SLIME will now automatically be available in your Lisp source
+  buffers.
+
+Licence.
+----------------------------------------
+
+  SLIME is free software. All files, unless explicitly stated
+  otherwise, are public domain.
+
+Contact.
+----------------------------------------
+
+  Questions and comments are best directed to the mailing list:
+    http://common-lisp.net/mailman/listinfo/slime-devel
+
+  The mailing list archive is also available on Gmane:
+    http://news.gmane.org/gmane.lisp.slime.devel
+

Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,30 @@
+/ChangeLog/1.62/Mon Oct  1 13:37:22 2007//
+/README/1.3/Fri Sep 28 13:05:44 2007//
+/bridge.el/1.1/Wed Sep 19 11:47:03 2007//
+/inferior-slime.el/1.2/Mon Sep 10 21:44:48 2007//
+/slime-asdf.el/1.3/Fri Sep 21 12:44:13 2007//
+/slime-autodoc.el/1.5/Mon Oct  1 13:37:10 2007//
+/slime-banner.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-c-p-c.el/1.8/Thu Sep 20 14:55:53 2007//
+/slime-editing-commands.el/1.5/Thu Sep 20 14:55:53 2007//
+/slime-fancy-inspector.el/1.2/Thu Sep 20 14:55:53 2007//
+/slime-fancy.el/1.4/Fri Sep 28 13:05:35 2007//
+/slime-fuzzy.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-highlight-edits.el/1.3/Thu Sep 20 14:55:53 2007//
+/slime-parse.el/1.7/Sat Sep 15 11:09:36 2007//
+/slime-presentation-streams.el/1.2/Tue Aug 28 08:25:12 2007//
+/slime-presentations.el/1.8/Thu Sep 20 14:55:53 2007//
+/slime-references.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-scratch.el/1.4/Thu Sep 20 14:55:53 2007//
+/slime-tramp.el/1.2/Tue Sep  4 10:18:44 2007//
+/slime-typeout-frame.el/1.5/Mon Oct  1 11:50:06 2007//
+/slime-xref-browser.el/1.1/Fri Aug 24 14:47:11 2007//
+/swank-arglists.lisp/1.10/Tue Sep 11 12:33:00 2007//
+/swank-asdf.lisp/1.1/Tue Sep  4 10:32:07 2007//
+/swank-c-p-c.lisp/1.2/Wed Sep  5 19:35:35 2007//
+/swank-fancy-inspector.lisp/1.4/Thu Sep 20 14:55:53 2007//
+/swank-fuzzy.lisp/1.6/Sat Sep 15 22:21:21 2007//
+/swank-listener-hooks.lisp/1.1/Tue Aug 28 13:53:02 2007//
+/swank-presentation-streams.lisp/1.4/Tue Aug 28 16:26:32 2007//
+/swank-presentations.lisp/1.4/Tue Sep  4 09:49:10 2007//
+D

Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Repository	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+slime/contrib

Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Root	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+:pserver:anonymous:anonymous at common-lisp.net:/project/slime/cvsroot

Added: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Template
===================================================================

Added: branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,500 @@
+2007-10-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-autdoc.el (slime-autodoc-message-ok-p): Don't display an
+	arglist when the minibuffer is active.
+
+2007-10-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-typeout-frame.el: Messages in the typeout frame were too
+	easily overwritten by `slime-autodoc'. Fix that.
+	Reported by Geoff Wozniak.
+	
+	(slime-typeout-message-aux): Split out from `slime-typeout-message'.
+	(slime-typeout-message): Wrapper around it. Additionally disable
+	the autodoc timer temporarily.
+
+2007-09-30  Geoff Wozniak  <geoff at wozniak.ca>
+
+	* slime-typeout-frame.el (slime-typeout-frame-init): Fix quoted
+	FUNCTION forms in literal.
+
+2007-09-28  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* README: Updated.
+
+	* slime-fancy.el: `slime-highlighting-edits' is not enabled by
+	default anymore, as its functionality is controversial, and it's
+	easier to explicitly enable it than to disable it once it got
+	globally activated. Better to be conservative.
+
+	* slime-fancy.el: Not only load, but also enable `slime-scratch'.
+
+2007-09-21  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-asdf.el (slime-asdf-init, slime-asdf-unload): Fix typos.
+	Reported by Ariel Badichi.
+
+2007-09-20  Helmut Eller  <heller at common-lisp.net>
+
+	Separate loading from initialization for many contribs.
+
+	* slime-asdf.el
+	* slime-autodoc.el
+	* slime-banner.el
+	* slime-c-p-c.el
+	* slime-editing-commands.el
+	* slime-fancy-inspector.el
+	* slime-fuzzy.el
+	* slime-highlight-edits.el
+	* slime-presentations.el
+	* slime-references.el
+	* slime-scratch.el
+	* slime-typeout-frame.el
+	* swank-fancy-inspector.lisp
+
+	* slime-fancy.el: As an exception, call the respective init
+	function when loading.
+
+2007-09-19  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-c-p-c.el (slime-complete-symbol*-fancy): Move defcustom
+	from slime.el to contrib/slime-c-p-c.el.
+
+2007-09-16  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-fuzzy.lisp: Fix regression that would not allow to fuzzy
+	complete on inputs without package qualifier like "app".
+	Reported by David J. Neu.
+	
+	(%make-duplicate-symbols-filter): Return complement.
+	(fuzzy-find-matching-symbols): Treat passed filter as an acceptor
+	predicate, not as a rejector.
+	
+2007-09-15  Helmut Eller  <heller at common-lisp.net>
+
+	Add the necessary hooks when loading some contribs, so that those
+	contribs can be easily loaded with slime-setup.
+
+	* slime-highlight-edits.el (slime-highlight-edits-mode-on): New
+	function.  Add this to slime-mode-hook by default.
+
+	* slime-autodoc.el (slime-use-autodoc-mode): Change default to t.
+
+2007-09-15  Ariel Badichi <abadichi at bezeqint.net>
+
+	* swank-fancy-inspector.lisp (inspect-for-emacs package): When
+        inspecting a package, the links in the use list and the used-by
+        list lead to inspecting package names, rather than the packages
+        themselves. Fix that.
+
+2007-09-15  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el: Fix extended arglist display on misbalanced
+	expressions like `(defun foo | ... (defun bar () 'bar)'
+	Reported by Ariel Badichi.
+	
+	(slime-inside-string-p): Use `beginning-of-defun' directly than
+	relying on `slime-region-for-defun-at-point' (as this one uses
+	`end-of-defun' which signals an error on misbalanced expressions.)
+
+2007-09-15  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-fuzzy.lisp: Code reorganization and cleanup; making it
+	compute less and couple of other minor issues fixed on the
+	way. Thanks to Stelian Ionescu for testing and providing feedback!
+
+	(defstruct fuzzy-matching): New `package-name' slot.
+	(make-fuzzy-matching): Updated for new slot.
+	(format-completion-result): Renamed to `fuzzy-format-matching'.
+	(%fuzzy-extract-matching-info): Helper for `fuzzy-format-matching'.
+
+	(fuzzy-completion-set): Convert the matchings after they got
+	truncated to the passed completion-set limit from Emacs.
+	I.e. `slime-fuzzy-completion-limit' This means a huge
+	computational reduction.
+
+	(fuzzy-create-completion-set): Renamed to `fuzzy-generate-matchings'.
+	(fuzzy-generate-matchings): Returns the fuzzy matchings
+	themselves, do not yet convert them for Emacs. Do not perform two
+	sorts on the generated matchings (first alphabetically, then per
+	score), but just one with an appropriate predicate that sorts per
+	score, unless matchings are equal, then sort alphabetically. Prune
+	matchings with symbols which are found in a differenta package
+	than their home package when the home package is among the matched
+	packages. Try to take the time needed to sort the generated
+	matchings into account for the time-limit.
+	(%guess-sort-duration): Helper. 
+	Tries to guess how long the sort will take.
+	(%make-duplicate-symbols-filter): Helper. 
+	Used for pruning of matchings.
+	(fuzzy-matching-greaterp): New testing predicate for sorting.
+
+	(fuzzy-find-matching-symbols): Now takes a :filter keyarg; only
+	considers symbols that pass through the filter.
+	(fuzzy-find-matching-packages): Do not return matchings for all
+	nicknames of package, but just the one that matches best.	
+	
+2007-09-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-editing-commands.el: Automatically bind the editing
+	commands when this module is required. (Previously, one had to
+	enable them explicitly, but this is inconsistent to, for instance,
+	the `slime-c-p-c' module which also sets up its bindings
+	automatically.)
+	(slime-bind-editing-commands): Renamed to `slime-editing-commands-init'.
+	(slime-editing-commands-init): Evaluated at toplevel.
+
+2007-09-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el (slime-enclosing-form-specs): Now also works even
+	when point is inside a string.
+	(slime-inside-string-p): New function.
+	(slime-beginning-of-string): New function.
+
+2007-09-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglist.lisp (read-conversatively-for-autodoc): Also parse
+	quoted symbols explicitly. This fixed extended arglist display for
+	`(make-instance 'foo'. Reported by: Johannes Groedem.
+
+2007-09-11  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-fancy.el: Require `slime-references'.
+	
+2007-09-10  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-parse.el (slime-cl-symbol-name, slime-cl-symbol-package):
+	Move from slime.el to contrib/slime-parse.el.
+
+2007-09-10  Helmut Eller  <heller at common-lisp.net>
+
+	* inferior-slime.el: Fix installation comment.
+
+2007-09-10  Helmut Eller  <heller at common-lisp.net>
+
+	Fix some of the bugs introduced with the last change.
+	
+	* slime-references.el (sldb-reference-face): Add missing quote.
+	(sldb-reference-properties): We are lucky and can use keywords
+	instead of strings.
+	(sldb-maybe-insert-references): Insert newlines differently.
+	
+2007-09-10  Helmut Eller  <heller at common-lisp.net>
+
+	Move SBCL doc references to contrib.
+
+	* slime-references.el: New file.
+
+2007-09-10  Attila Lendvai  <attila.lendvai at gmail.com>
+
+	* slime-fuzzy.el: Fixed some race condition that prevented a
+	proper closing of the *Fuzzy Completions* buffer in some
+	circumstances.
+	
+	(slime-fuzzy-save-window-configuration): Removed. Hooking up
+	`window-configuration-change-hook' via `run-with-timer' was racy
+	and lead to this bug; we now set the hook explicitely at the
+	necessary place instead.
+	(slime-fuzzy-window-configuration-change-add-hook): Removed.
+	(slime-fuzzy-choices-buffer): Explicitly save the
+	window-configuration, and explicitly set the hook.
+	(slime-fuzzy-done): Explicitely remove the hook.
+
+2007-09-10  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-parse.el (slime-cl-symbol-name, slime-cl-symbol-package):
+	Moved back into slime.el.
+
+2007-09-08  Stelian Ionescu  <sionescu at common-lisp.net>
+
+	* slime-banner.el: Fixed typo to provide `slime-banner', not
+	`slime-startup-animation'.
+
+2007-09-06  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime-presentations.el (slime-presentation-write): Use case, not
+	ecase, for dispatching targets.  Should fix XEmacs compatibility.
+	Reported by Steven E. Harris.
+
+2007-09-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-c-p-c.el: This file incorrectly provided the module
+	`:swank-compound-prefix'; changed that to `:swank-c-p-c'. 
+
+	This gets rid off the nasty redefinition warnings that were
+	previously signalled when loading SWANK with SBCL.
+
+	* swank-arglist.lisp (arglist-for-echo-area): Locally declare
+	`*arglist-pprint-bindings*' to be special, as the variable is
+	defined later in the file. (Gets rid of warnings during loading.)
+
+2007-09-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-c-p-c.el (slime-c-p-c-init): Bind `slime-complete-form' to
+	`C-c C-s' in `slime-repl-mode-map'.
+	
+2007-09-05  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Added extended arglist display for DECLAIM and PROCLAIM.
+	
+	* slime-parse.el (slime-extended-operator-name-parser-alist): Added
+	entries for "DECLAIM", and "PROCLAIM".
+	(slime-parse-extended-operator/declare): Provide information about
+	the operator the arglist is requested for.
+	(slime-make-form-spec-from-string): Fixed for "()" as input.
+	
+	* swank-arglists.lisp (valid-operator-symbol-p): Explicitly allow
+	the symbol 'DECLARE.
+	(arglist-dispatch): New method for `DECLARE'. We have to catch
+	this explicitly, as DECLARE doesn't have an arglist (in the
+	`swank-backend:arglist' sense.)
+	(*arglist-pprint-bindings*): New variable. Splitted out from
+	`decoded-arglist-to-string'.
+	(decoded-arglist-to-string): Use `*arglist-pprint-bindings*'.
+
+	(parse-first-valid-form-spec): Rewritten, because function
+	signature had to be changed: doesn't take arg-indices anymore;
+	returns position of first valid spec as second value to remedy.
+	(arglist-for-echo-area): Accomodated to new signature of
+	`parse-first-valid-form-spec'; now searchs for contextual
+	declaration operator name, to prefix a declaration arglist by
+	"declare", "declaim", or "proclaim" depending on what was used at
+	user's point in Slime. Use `*arglist-pprint-bindings*' for
+	printing the found declaration operator name.
+	(%find-declaration-operator): New helper to do this search.
+	(completions-for-keyword): Accomodated to new signature of
+	`parse-first-valid-form-spec'. Also fixed to correctly provide
+	keyword completions in nested expressions like:
+
+	   `(defun foo (x)
+	      (let ((bar 'quux))
+	        (with-open-file (s f :|'    [`|' being point]
+	
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-arglists.lisp (parse-first-valid-form-spec): Rewrite it for
+	ABCL.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Some bug fixes for slime-complete-symbol*.
+	Patches by Mr. Madhu <enometh at meer.net>
+
+	* slime-c-p-c.el (slime-c-p-c-unambiguous-prefix-p): New variable.
+	(slime-expand-abbreviations-and-complete): Use it. Also add a
+	workaround for XEmacs issues.
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	Move asdf support to contrib:
+
+	* slime-asdf.el: New file.
+
+	* swank-asdf.lisp: New file
+	(operate-on-system, asdf-central-registry)
+	(list-all-systems-known-to-asdf): Use the asdf package in the
+	source code, i.e. write asdf:operate instead of
+	 (find-symbol "OPERATE" "ASDF").
+
+2007-09-04  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-tramp.el: New file.
+	* slime-banner.el: New file.
+	* inferior-slime.el: New file.
+
+2007-09-01  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime-fancy.el: New meta-contrib.
+
+2007-09-01  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime-presentations.el (slime-dispatch-presentation-event):
+	Explicitly return t to indicate the events have been handled,
+	rather than relying on the return values of the called functions.
+
+2007-09-01  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime-typeout-frame.el (slime-typeout-autodoc-message): Fix for
+	messages that contain "%".  Reported by Martin Simmons.
+
+2007-09-01  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Makes `slime-complete-form' work on `(eval-when |'; doesn't work
+	on `(eval-when (|' yet.
+	
+	* slime-parse.el (slime-parse-sexp-at-point): Guard against
+	`(char-after)' being NIL at end of buffer (especially important
+	for use on the REPL.)
+
+	* swank-arglist.lisp (arglist-dispatch 'eval-when): Fix typo.
+	(print-decoded-arglist-as-template): Print keywords with PRIN1.
+	
+2007-08-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	Added extended arglist display for EVAL-WHEN, viz:
+
+	  (eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
+
+	Notice that completion works as expected on these keywords.
+
+	Die, EVAL-ALWAYS, die!
+
+	* swank-arglist (arglist-dispatch): New method for EVAL-WHEN.
+	(print-arglist): Print keywords with PRIN1 rather than PRINC,
+	to get a result as shown above for the EVAL-WHEN case.
+	(completions-for-keyword): Add support for &ANY args.	 
+	
+2007-08-31  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* swank-arglist.lisp: Do not fall back to READ when interpreting
+	the ``raw form specs'' comming from Slime's autodoc stuff. But
+	still do so for those comming from `slime-complete-form'.
+
+	(unintern-in-home-package): New.
+
+	(*arglist-dummy*): New.
+	(read-conversatively-for-autodoc): New function. Doesn't READ
+	anything that comes from Slime's autodoc. Just tries to parse
+	symbols. If that's not successfull, returns the dummy placeholder
+	datum stored in `*arglist-dummy*'.
+	(arglist-for-echo-area): Parse form-specs using
+	`read-conversatively-for-autodoc'. Use `unintern-in-home-package'.
+
+	(read-softly): New. Splitted out from `read-form-spec'. This
+	function tries to keep track of newly interned functions before
+	READing.
+	(read-form-spec): Parametrized to take a function to read the
+	elements of the passed ``raw form spec''. Uses `read-softly' as
+	default reader.
+
+	(complete-form, completions-for-keywords): 
+	Use `unintern-in-home-package'.
+
+2007-08-31  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-autodoc.el: Add installation notes.
+	* slime-editing-commands.el: Add installation notes.
+	* slime-c-p-c.el (slime-c-p-c-init): Fix typos.
+
+2007-08-31  Helmut Eller  <heller at common-lisp.net>
+
+	Move compound prefix completion and autodoc to contrib.
+	Interdependencies made it almost necessary to move parsing code
+	and editing commands in the same patch.
+
+	* slime-c-p-c.el: New file.
+	* swank-c-p-c.el: New file.
+	* slime-parse.el: New file.
+	* swank-arglists.el: New file.
+	* slime-editing-commands.el: New file.
+	* slime-autodoc.el: New file.
+
+2007-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* slime-presentations.el (slime-last-output-target-id)
+	(slime-output-target-to-marker, slime-output-target-marker)
+	(slime-redirect-trace-output): Moved back into SLIME core.
+
+	* swank-presentation-streams.lisp: Require swank-presentations.
+	(present-repl-results-via-presentation-streams): New.
+	(*send-repl-results-function*): Set this variable rather than
+	overriding send-repl-results-to-emacs.
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-presentations.el (slime-clear-presentations): New
+	function. Add it to slime-repl-clear-buffer-hook.
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	* swank-listener-hooks.lisp: New file
+
+2007-08-28  Helmut Eller  <heller at common-lisp.net>
+
+	Move the rest of the presentation related code.
+
+	* swank-presentations.lisp (present-repl-results): Renamed from
+	send-repl-results-to-emacs.
+
+2007-08-28  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	* swank-presentations.lisp (send-repl-results-to-emacs): 
+	Override core defun to mark up REPL results as presentations.
+	
+	* swank-presentations.lisp: New file.
+	* slime-presentations.el: Load it.
+
+	* slime-presentations.el (slime-presentation-write): Remove id
+	argument.
+
+	* slime-presentation-streams.el: Require slime-presentations contrib.
+
+2007-08-27  Helmut Eller  <heller at common-lisp.net>
+
+	Move presentations to contrib. (ELisp part)
+
+	* slime-presentations.el: New file.
+	* slime-scratch.el (slime-scratch-buffer): Ignore presentations.
+
+2007-08-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Some fixes to the presentation-streams contrib.
+	
+	* swank-presentation-streams.lisp [sbcl]: Load the pretty-printer
+	patch only at load time.  Add some trickery so that SBCL does not
+	complain about the changed layout of the pretty-stream class.
+	
+	* swank-presentation-streams.lisp (slime-stream-p): Using special
+	return values, indicate whether we are printing to the
+	REPL-results stream, or a dedicated stream.
+	(presentation-record): New slot "target".
+	(presentation-start, presentation-end): Use it (rather than the
+	global variable *use-dedicated-output-stream*) to decide whether
+	to use the bridge protocol or the :presentation-start/-end
+	protocol.  Also use it as the TARGET argument of
+	:presentation-start/-end messages. 
+	(presenting-object-1): Use the new return values of
+	slime-stream-p.
+	
+	* swank-presentation-streams.lisp (slime-stream-p) [cmu]: Use the
+	return value of slime-stream-p rather than the global variable
+	*use-dedicated-output-stream* to decide whether printing through
+	pretty streams is safe for the layout.
+
+2007-08-24  Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+
+	Make the fancy "presentation streams" feature a contrib.
+	Previously, it was only available if "present.lisp" was loaded
+	manually. 
+	
+	* slime-presentation-streams.el: New file.
+	* swank-presentation-streams.lisp: New file, moved here from
+	../present.lisp 
+
+2007-08-24  Helmut Eller  <heller at common-lisp.net>
+
+	* slime-typeout-frame.el: New file.
+	* slime-xref-browser.el: New file.
+	* slime-highlight-edits.el: New file.
+	* slime-scratch.el: New file.
+
+2007-08-23  Helmut Eller  <heller at common-lisp.net>
+
+	Move Marco Baringer's inspector to contrib.
+
+	* swank-fancy-inspector.lisp: New file. The only difference to the
+	code is that inspect-for-emacs methods in this file are
+	specialized to the new class `fancy-inspector'.
+	(fancy-inspector): New class.
+
+	* slime-fancy-inspector.el: New file.
+
+2007-08-19  Helmut Eller  <heller at common-lisp.net>
+
+	Moved fuzzy completion code to contrib directory.
+
+	* slime-fuzzy.el: New file.
+	(slime-fuzzy-init): New function.  Load CL code on startup.
+
+	* swank-fuzzy.lisp: New file. Common Lisp code for fuzzy
+	completion.

Added: branches/trunk-reorg/thirdparty/slime/contrib/README
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/README	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/README	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,30 @@
+This directory contains source code which may be useful to some Slime
+users.  *.el files are Emacs Lisp source and *.lisp files contain
+Common Lisp source code.  If not otherwise stated in the file itself,
+the files are placed in the Public Domain.
+
+The components in this directory are more or less detached from the
+rest of Slime.  They are essentially "add-ons".  But Slime can also be
+used without them.  The code is maintained by the respective authors.
+
+To use the packages here, you should add this directory to your Emacs
+load-path, require the contrib, and call the contrib's init function to
+enable the functionality that's provided by the respective contrib.
+
+E.g. for fuzzy completion add this to your .emacs:
+
+  (add-to-list 'load-path "<this-directory>")
+  (add-hook 'slime-load-hook (lambda () (require 'slime-fuzzy)
+                                        (slime-fuzzy-init)))
+
+Alternatively, you can use the `slime-setup' function which takes a
+list of contrib names, and which loads and enables them automatically
+for you:
+
+  (slime-setup '(slime-fancy slime-asdf slime-tramp ...))
+  
+
+Finally, the contrib `slime-fancy' is specially noteworthy, as it
+represents a meta-contrib that'll load a bunch of commonly used
+contribs. Look into `slime-fancy.el' to find out which.
+ 
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/bridge.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/bridge.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/bridge.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,467 @@
+;;; -*-Emacs-Lisp-*-
+;;;%Header
+;;; Bridge process filter, V1.0
+;;; Copyright (C) 1991 Chris McConnell, ccm at cs.cmu.edu  
+;;;
+;;; Send mail to ilisp at cons.org if you have problems.
+;;;
+;;; Send mail to majordomo at cons.org if you want to be on the
+;;; ilisp mailing list.
+
+;;; This file is part of GNU Emacs.
+
+;;; GNU Emacs is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY.  No author or distributor
+;;; accepts responsibility to anyone for the consequences of using it
+;;; or for whether it serves any particular purpose or works at all,
+;;; unless he says so in writing.  Refer to the GNU Emacs General Public
+;;; License for full details.
+
+;;; Everyone is granted permission to copy, modify and redistribute
+;;; GNU Emacs, but only under the conditions described in the
+;;; GNU Emacs General Public License.   A copy of this license is
+;;; supposed to have been given to you along with GNU Emacs so you
+;;; can know your rights and responsibilities.  It should be in a
+;;; file named COPYING.  Among other things, the copyright notice
+;;; and this notice must be preserved on all copies.
+
+;;; Send any bugs or comments.  Thanks to Todd Kaufmann for rewriting
+;;; the process filter for continuous handlers.
+
+;;; USAGE: M-x install-bridge will add a process output filter to the
+;;; current buffer.  Any output that the process does between
+;;; bridge-start-regexp and bridge-end-regexp will be bundled up and
+;;; passed to the first handler on bridge-handlers that matches the
+;;; output using string-match.  If bridge-prompt-regexp shows up
+;;; before bridge-end-regexp, the bridge will be cancelled.  If no
+;;; handler matches the output, the first symbol in the output is
+;;; assumed to be a buffer name and the rest of the output will be
+;;; sent to that buffer's process.  This can be used to communicate
+;;; between processes or to set up two way interactions between Emacs
+;;; and an inferior process.
+
+;;; You can write handlers that process the output in special ways.
+;;; See bridge-send-handler for the default handler.  The command
+;;; hand-bridge is useful for testing.  Keep in mind that all
+;;; variables are buffer local.
+
+;;; YOUR .EMACS FILE:
+;;;
+;;; ;;; Set up load path to include bridge
+;;; (setq load-path (cons "/bridge-directory/" load-path))
+;;; (autoload 'install-bridge "bridge" "Install a process bridge." t)
+;;; (setq bridge-hook 
+;;;       '(lambda ()
+;;;         ;; Example options
+;;;         (setq bridge-source-insert nil) ;Don't insert in source buffer
+;;;         (setq bridge-destination-insert nil) ;Don't insert in dest buffer
+;;;         ;; Handle copy-it messages yourself
+;;;         (setq bridge-handlers
+;;;          '(("copy-it" . my-copy-handler)))))
+
+;;; EXAMPLE:
+;;; # This pipes stdin to the named buffer in a Unix shell
+;;; alias devgnu '(echo -n "\!* "; cat -; echo -n "")'
+;;;
+;;; ls | devgnu *scratch*
+
+(eval-when-compile
+  (require 'cl))
+
+;;;%Parameters
+(defvar bridge-hook nil
+  "Hook called when a bridge is installed by install-hook.")
+
+(defvar bridge-start-regexp ""
+  "*Regular expression to match the start of a process bridge in
+process output.  It should be followed by a buffer name, the data to
+be sent and a bridge-end-regexp.")
+
+(defvar bridge-end-regexp ""
+  "*Regular expression to match the end of a process bridge in process
+output.")
+
+(defvar bridge-prompt-regexp nil
+  "*Regular expression for detecting a prompt.  If there is a
+comint-prompt-regexp, it will be initialized to that.  A prompt before
+a bridge-end-regexp will stop the process bridge.")
+
+(defvar bridge-handlers nil
+  "Alist of (regexp . handler) for handling process output delimited
+by bridge-start-regexp and bridge-end-regexp.  The first entry on the
+list whose regexp matches the output will be called on the process and
+the delimited output.")
+
+(defvar bridge-source-insert t
+  "*T to insert bridge input in the source buffer minus delimiters.")
+
+(defvar bridge-destination-insert t
+  "*T for bridge-send-handler to insert bridge input into the
+destination buffer minus delimiters.")
+
+(defvar bridge-chunk-size 512
+  "*Long inputs send to comint processes are broken up into chunks of
+this size.  If your process is choking on big inputs, try lowering the
+value.")
+
+;;;%Internal variables
+(defvar bridge-old-filter nil
+  "Old filter for a bridged process buffer.")
+
+(defvar bridge-string nil 
+  "The current output in the process bridge.")
+
+(defvar bridge-in-progress nil
+  "The current handler function, if any, that bridge passes strings on to,
+or nil if none.")
+
+(defvar bridge-leftovers nil
+  "Because of chunking you might get an incomplete bridge signal - start but the end is in the next packet. Save the overhanging text here.")
+
+(defvar bridge-send-to-buffer nil
+  "The buffer that the default bridge-handler (bridge-send-handler) is
+currently sending to, or nil if it hasn't started yet.  Your handler
+function can use this variable also.")
+
+(defvar bridge-last-failure ()
+  "Last thing that broke the bridge handler.  First item is function call
+(eval'able); last item is error condition which resulted.  This is provided
+to help handler-writers in their debugging.")
+
+;;;%Utilities
+(defun bridge-insert (output)
+  "Insert process OUTPUT into the current buffer."
+  (if output
+      (let* ((buffer (current-buffer))
+	     (process (get-buffer-process buffer))
+	     (mark (process-mark process))
+	     (window (selected-window))
+	     (at-end nil))
+	(if (eq (window-buffer window) buffer)
+	    (setq at-end (= (point) mark))
+	    (setq window (get-buffer-window buffer)))
+	(save-excursion
+	  (goto-char mark)
+	  (insert output)
+	  (set-marker mark (point)))
+	(if window 
+	    (progn
+	      (if at-end (goto-char mark))
+	      (if (not (pos-visible-in-window-p (point) window))
+		  (let ((original (selected-window)))
+		    (save-excursion
+		      (select-window window)
+		      (recenter '(center))
+		      (select-window original)))))))))
+
+;;;
+;(defun bridge-send-string (process string)
+;  "Send PROCESS the contents of STRING as input.
+;This is equivalent to process-send-string, except that long input strings
+;are broken up into chunks of size comint-input-chunk-size. Processes
+;are given a chance to output between chunks. This can help prevent processes
+;from hanging when you send them long inputs on some OS's."
+;  (let* ((len (length string))
+;	 (i (min len bridge-chunk-size)))
+;    (process-send-string process (substring string 0 i))
+;    (while (< i len)
+;      (let ((next-i (+ i bridge-chunk-size)))
+;	(accept-process-output)
+;	(process-send-string process (substring string i (min len next-i)))
+;	(setq i next-i)))))
+
+;;;
+(defun bridge-call-handler (handler proc string)
+  "Funcall HANDLER on PROC, STRING carefully.  Error is caught if happens,
+and user is signaled.  State is put in bridge-last-failure.  Returns t if
+handler executed without error."
+  (let ((inhibit-quit nil)
+	(failed nil))
+    (condition-case err
+	(funcall handler proc string)
+      (error
+       (ding)
+       (setq failed t)
+       (message "bridge-handler \"%s\" failed %s (see bridge-last-failure)"
+		handler err)
+       (setq bridge-last-failure
+	     (` ((funcall '(, handler) '(, proc) (, string))
+		 "Caused: "
+		 (, err))))))
+    (not failed)))
+
+;;;%Handlers
+(defun bridge-send-handler (process input)
+  "Send PROCESS INPUT to the buffer name found at the start of the
+input.  The input after the buffer name is sent to the buffer's
+process if it has one.  If bridge-destination-insert is T, the input
+will be inserted into the buffer.  If it does not have a process, it
+will be inserted at the end of the buffer."
+  (if (null input)
+      (setq bridge-send-to-buffer nil)  ; end of bridge
+      (let (buffer-and-start buffer-name dest to)
+	;; if this is first time, get the buffer out of the first line
+	(cond ((not bridge-send-to-buffer)
+	       (setq buffer-and-start (read-from-string input)
+		     buffer-name (format "%s" (car (read-from-string input)))
+		     dest        (get-buffer buffer-name)
+		     to          (get-buffer-process dest)
+		     input (substring input (cdr buffer-and-start)))
+	       (setq bridge-send-to-buffer dest))
+	      (t
+	       (setq buffer-name bridge-send-to-buffer
+		     dest        (get-buffer buffer-name)
+		     to          (get-buffer-process dest)
+		     )))
+	(if dest
+	    (let ((buffer (current-buffer)))
+	      (if bridge-destination-insert
+		  (unwind-protect
+		       (progn
+			 (set-buffer dest)
+			 (if to 
+			     (bridge-insert process input)
+			     (goto-char (point-max))
+			     (insert input)))
+		    (set-buffer buffer)))
+	      (if to
+		  ;; (bridge-send-string to input)
+		  (process-send-string to input)
+		  ))
+	    (error "%s is not a buffer" buffer-name)))))
+
+;;;%Filter
+(defun bridge-filter (process output)
+  "Given PROCESS and some OUTPUT, check for the presence of
+bridge-start-regexp.  Everything prior to this will be passed to the
+normal filter function or inserted in the buffer if it is nil.  The
+output up to bridge-end-regexp will be sent to the first handler on
+bridge-handlers that matches the string.  If no handlers match, the
+input will be sent to bridge-send-handler.  If bridge-prompt-regexp is
+encountered before the bridge-end-regexp, the bridge will be cancelled."
+  (let ((inhibit-quit t)
+	(match-data (match-data))
+	(buffer (current-buffer))
+	(process-buffer (process-buffer process))
+	(case-fold-search t)
+	(start 0) (end 0)
+	function
+	b-start b-start-end b-end)
+    (set-buffer process-buffer)	;; access locals
+
+    ;; Handle bridge messages that straddle a packet by prepending
+    ;; them to this packet.
+
+    (when bridge-leftovers
+      (setq output (concat bridge-leftovers output))
+      (setq bridge-leftovers nil))
+
+    (setq function bridge-in-progress)
+
+    ;; How it works:
+    ;;
+    ;; start, end delimit the part of string we are interested in;
+    ;; initially both 0; after an iteration we move them to next string.
+
+    ;; b-start, b-end delimit part of string to bridge (possibly whole string);
+    ;; this will be string between corresponding regexps.
+
+    ;; There are two main cases when we come into loop:
+
+    ;;  bridge in progress
+    ;;0    setq b-start = start
+    ;;1    setq b-end (or end-pattern end)
+    ;;4    process string
+    ;;5    remove handler if end found
+     
+    ;;  no bridge in progress
+    ;;0    setq b-start if see start-pattern
+    ;;1    setq b-end if bstart to (or end-pattern end)
+    ;;2    send (substring start b-start)  to normal place
+    ;;3    find handler (in b-start, b-end) if not set
+    ;;4    process string
+    ;;5    remove handler if end found
+
+    ;; equivalent sections have the same numbers here;
+    ;; we fold them together in this code.
+
+    (block bridge-filter
+      (unwind-protect
+	  (while (< end (length output))
+
+	    ;;0    setq b-start if find
+	    (setq b-start
+		  (cond (bridge-in-progress
+			 (setq b-start-end start)
+			 start)
+			((string-match bridge-start-regexp output start)
+			 (setq b-start-end (match-end 0))
+			 (match-beginning 0))
+			(t nil)))
+	    ;;1    setq b-end
+	    (setq b-end
+		  (if b-start
+		      (let ((end-seen (string-match bridge-end-regexp
+						    output b-start-end)))
+			(if end-seen (setq end (match-end 0)))
+
+			end-seen)))
+
+	    ;; Detect and save partial bridge messages
+	    (when (and b-start b-start-end (not b-end))
+	      (setq bridge-leftovers (substring output b-start))
+	      )
+
+	    (if (and b-start (not b-end))
+	      (setq end b-start)
+	    (if (not b-end)
+		(setq end (length output))))
+
+	    ;;1.5 - if see prompt before end, remove current
+	    (if (and b-start b-end)
+		(let ((prompt (string-match bridge-prompt-regexp
+					    output b-start-end)))
+		  (if (and prompt (<= (match-end 0) b-end))
+		      (setq b-start nil	; b-start-end start
+			    b-end   start
+			    end     (match-end 0)
+			    bridge-in-progress nil
+			    ))))
+
+	    ;;2    send (substring start b-start) to old filter, if any
+	    (when (not (equal start (or b-start end))) ; don't bother on empty string
+	      (let ((pass-on (substring output start (or b-start end))))
+		(if bridge-old-filter
+		    (let ((old bridge-old-filter))
+		      (store-match-data match-data)
+		      (funcall old process pass-on)
+		      ;; if filter changed, re-install ourselves
+		      (let ((new (process-filter process)))
+			(if (not (eq new 'bridge-filter))
+			    (progn (setq bridge-old-filter new)
+				   (set-process-filter process 'bridge-filter)))))
+		  (set-buffer process-buffer)
+		  (bridge-insert pass-on))))
+
+	    (if (and b-start-end (not b-end)) 
+		(return-from bridge-filter t) ; when last bit has prematurely ending message, exit  early.
+	      (progn
+		;;3 find handler (in b-start, b-end) if none current
+		(if (and b-start (not bridge-in-progress))
+		    (let ((handlers bridge-handlers))
+		      (while (and handlers (not function))
+			(let* ((handler (car handlers))
+			       (m (string-match (car handler) output b-start-end)))
+			  (if (and m (< m b-end))
+			      (setq function (cdr handler))
+			    (setq handlers (cdr handlers)))))
+		      ;; Set default handler if none
+		      (if (null function)
+			  (setq function 'bridge-send-handler))
+		      (setq bridge-in-progress function)))
+		;;4    process strin
+		(if function
+		    (let ((ok t))
+		      (if (/=  b-start-end b-end)
+			  (let ((send (substring output b-start-end b-end)))
+			    ;; also, insert the stuff in buffer between
+			    ;; iff bridge-source-insert.
+			    (if bridge-source-insert (bridge-insert send))
+			    ;; call handler on string
+			    (setq ok (bridge-call-handler function process send))))
+		      ;;5    remove handler if end found
+		      ;; if function removed then tell it that's all
+		      (if (or (not ok) (/= b-end end)) ;; saw end before end-of-string
+			  (progn
+			    (bridge-call-handler function process nil)
+			    ;; have to remove function too for next time around
+			    (setq function nil
+				  bridge-in-progress nil)
+			    ))
+		      ))
+     
+		;; continue looping, in case there's more string
+		(setq  start end))
+	      ))
+	;; protected forms:  restore buffer, match-data
+	(set-buffer buffer)
+	(store-match-data match-data)
+	))))
+
+
+;;;%Interface
+(defun install-bridge ()
+  "Set up a process bridge in the current buffer."
+  (interactive)
+  (if (not (get-buffer-process (current-buffer)))
+      (error "%s does not have a process" (buffer-name (current-buffer)))
+      (make-local-variable 'bridge-start-regexp)
+      (make-local-variable 'bridge-end-regexp)
+      (make-local-variable 'bridge-prompt-regexp)
+      (make-local-variable 'bridge-handlers)
+      (make-local-variable 'bridge-source-insert)
+      (make-local-variable 'bridge-destination-insert)
+      (make-local-variable 'bridge-chunk-size)
+      (make-local-variable 'bridge-old-filter)
+      (make-local-variable 'bridge-string)
+      (make-local-variable 'bridge-in-progress)
+      (make-local-variable 'bridge-send-to-buffer)
+      (make-local-variable 'bridge-leftovers)
+      (setq bridge-string nil bridge-in-progress nil
+	    bridge-send-to-buffer nil)
+      (if (boundp 'comint-prompt-regexp)
+	  (setq bridge-prompt-regexp comint-prompt-regexp))
+      (let ((process (get-buffer-process (current-buffer))))
+	(if process
+	    (if (not (eq (process-filter process) 'bridge-filter))
+		(progn
+		  (setq bridge-old-filter (process-filter process))
+		  (set-process-filter process 'bridge-filter)))
+	    (error "%s does not have a process" 
+		   (buffer-name (current-buffer)))))
+      (run-hooks 'bridge-hook)
+      (message "Process bridge is installed")))
+	      
+;;;
+(defun reset-bridge ()
+  "Must be called from the process's buffer.  Removes any active bridge."
+  (interactive)
+  ;; for when things get wedged
+  (if bridge-in-progress
+      (unwind-protect
+	   (funcall bridge-in-progress (get-buffer-process
+					(current-buffer))
+		    nil)
+	(setq bridge-in-progress nil))
+      (message "No bridge in progress.")))
+
+;;;
+(defun remove-bridge ()
+  "Remove bridge from the current buffer."
+  (interactive)
+  (let ((process (get-buffer-process (current-buffer))))
+    (if (or (not process) (not (eq (process-filter process) 'bridge-filter)))
+	(error "%s has no bridge" (buffer-name (current-buffer)))
+	;; remove any bridge-in-progress
+	(reset-bridge)
+	(set-process-filter process bridge-old-filter)
+	(funcall bridge-old-filter process bridge-string)
+	(message "Process bridge is removed."))))
+
+;;;% Utility for testing
+(defun hand-bridge (start end)
+  "With point at bridge-start, sends bridge-start + string +
+bridge-end to bridge-filter.  With prefix, use current region to send."
+  (interactive "r")
+  (let ((p0 (if current-prefix-arg (min start end)
+		(if (looking-at bridge-start-regexp) (point)
+		    (error "Not looking at bridge-start-regexp"))))
+	(p1 (if current-prefix-arg (max start end)
+		(if (re-search-forward bridge-end-regexp nil t)
+		    (point) (error "Didn't see bridge-end-regexp")))))
+    
+    (bridge-filter (get-buffer-process (current-buffer))
+		   (buffer-substring-no-properties p0 p1))
+    ))
+
+(provide 'bridge)

Added: branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/inferior-slime.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,88 @@
+;;; inferior-slime.el --- Minor mode with Slime keys for comint buffers
+;;
+;; Author: Luke Gorrie  <luke at synap.se>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'inferior-slime)))
+;;   (add-hook 'inferior-lisp-mode-hook (lambda () (inferior-slime-mode 1)))
+
+(define-minor-mode inferior-slime-mode
+  "\\<slime-mode-map>\
+Inferior SLIME mode: The Inferior Superior Lisp Mode for Emacs.
+
+This mode is intended for use with `inferior-lisp-mode'. It provides a
+subset of the bindings from `slime-mode'.
+
+\\{inferior-slime-mode-map}"
+  nil
+  nil
+  ;; Fake binding to coax `define-minor-mode' to create the keymap
+  '((" " 'undefined)))
+
+(add-to-list 'minor-mode-alist
+             '(inferior-slime-mode
+               (" Inf-Slime" slime-state-name)))
+
+(defun inferior-slime-return ()
+  "Handle the return key in the inferior-lisp buffer.
+The current input should only be sent if a whole expression has been
+entered, i.e. the parenthesis are matched.
+
+A prefix argument disables this behaviour."
+  (interactive)
+  (if (or current-prefix-arg (inferior-slime-input-complete-p))
+      (comint-send-input)
+    (insert "\n")
+    (inferior-slime-indent-line)))
+
+(defun inferior-slime-indent-line ()
+  "Indent the current line, ignoring everything before the prompt."
+  (interactive)
+  (save-restriction
+    (let ((indent-start
+           (save-excursion
+             (goto-char (process-mark (get-buffer-process (current-buffer))))
+             (let ((inhibit-field-text-motion t))
+               (beginning-of-line 1))
+             (point))))
+      (narrow-to-region indent-start (point-max)))
+    (lisp-indent-line)))
+
+(defun inferior-slime-input-complete-p ()
+  "Return true if the input is complete in the inferior lisp buffer."
+  (slime-input-complete-p (process-mark (get-buffer-process (current-buffer)))
+                          (point-max)))
+
+(defun inferior-slime-closing-return ()
+  "Send the current expression to Lisp after closing any open lists."
+  (interactive)
+  (goto-char (point-max))
+  (save-restriction
+    (narrow-to-region (process-mark (get-buffer-process (current-buffer)))
+                      (point-max))
+    (while (ignore-errors (save-excursion (backward-up-list 1) t))
+      (insert ")")))
+  (comint-send-input))
+
+(defun inferior-slime-init-keymap ()
+  (let ((map inferior-slime-mode-map))
+    (define-key map [return] 'inferior-slime-return)
+    (define-key map [(control return)] 'inferior-slime-closing-return)
+    (define-key map [(meta control ?m)] 'inferior-slime-closing-return)
+    (define-key map "\C-c\C-d" slime-doc-map)
+    (define-key map "\C-c\C-w" slime-who-map)
+    (loop for (key command . keys) in slime-keys do
+	  (destructuring-bind (&key prefixed inferior &allow-other-keys) keys
+	    (when prefixed
+	      (setq key (concat slime-prefix-key key)))
+	    (when inferior
+	      (define-key map key command))))))
+
+(inferior-slime-init-keymap)
+
+(provide 'inferior-slime)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-asdf.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,113 @@
+;;; slime-asdf.el -- ASDF support
+;;
+;; Authors: Daniel Barlow  <dan at telent.net>
+;;          Marco Baringer <mb at bese.it>
+;;          Edi Weitz <edi at agharta.de>
+;;          and others 
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path ".../slime/contrib")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-asdf)))
+;;
+
+;; NOTE: `system-name' is a predefined variable in Emacs.  Try to
+;; avoid it as local variable name.
+
+
+(defun slime-load-system (&optional system)
+  "Compile and load an ASDF system.  
+
+Default system name is taken from first file matching *.asd in current
+buffer's working directory"
+  (interactive (list (slime-read-system-name)))
+  (slime-oos system "LOAD-OP"))
+
+(defvar slime-system-history nil
+  "History list for ASDF system names.")
+
+(defun slime-read-system-name (&optional prompt initial-value)
+  "Read a system name from the minibuffer, prompting with PROMPT."
+  (setq prompt (or prompt "System: "))
+  (let* ((completion-ignore-case nil)
+         (system-names (slime-eval `(swank:list-asdf-systems)))
+         (alist (slime-bogus-completion-alist system-names)))
+    (completing-read prompt alist nil nil
+                     (or initial-value (slime-find-asd system-names) "")
+                     'slime-system-history)))
+
+(defun slime-find-asd (system-names)
+  "Tries to find an ASDF system definition in the default
+directory or in the directory belonging to the current buffer and
+returns it if it's in `system-names'."
+  (let* ((asdf-systems-in-directory
+           (mapcar #'file-name-sans-extension
+                   (directory-files
+                    (file-name-directory (or default-directory
+                                             (buffer-file-name)))
+                    nil "\.asd$"))))
+    (loop for system in asdf-systems-in-directory
+          for candidate = (file-name-sans-extension system)
+          when (find candidate system-names :test #'string-equal)
+            do (return candidate))))
+
+(defun slime-oos (system operation &rest keyword-args)
+  (slime-save-some-lisp-buffers)
+  (slime-display-output-buffer)
+  (message "Performing ASDF %S%s on system %S"
+           operation (if keyword-args (format " %S" keyword-args) "")
+           system)
+  (slime-eval-async
+   `(swank:operate-on-system-for-emacs ,system ,operation , at keyword-args)
+   (slime-make-compilation-finished-continuation (current-buffer))))
+
+(defslime-repl-shortcut slime-repl-load/force-system ("force-load-system")
+  (:handler (lambda ()
+              (interactive)
+              (slime-oos (slime-read-system-name) "LOAD-OP" :force t)))
+  (:one-liner "Recompile and load an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-load-system ("load-system")
+  (:handler (lambda ()
+              (interactive)
+              (slime-oos (slime-read-system-name) "LOAD-OP")))
+  (:one-liner "Compile (as needed) and load an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-test/force-system ("force-test-system")
+  (:handler (lambda ()
+              (interactive)
+              (slime-oos (slime-read-system-name) "TEST-OP" :force t)))
+  (:one-liner "Compile (as needed) and force test an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-test-system ("test-system")
+  (:handler (lambda ()
+              (interactive)
+              (slime-oos (slime-read-system-name) "TEST-OP")))
+  (:one-liner "Compile (as needed) and test an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-compile-system ("compile-system")
+  (:handler (lambda ()
+              (interactive)
+              (slime-oos (slime-read-system-name) "COMPILE-OP")))
+  (:one-liner "Compile (but not load) an ASDF system."))
+
+(defslime-repl-shortcut slime-repl-compile/force-system 
+  ("force-compile-system")  
+  (:handler (lambda ()
+              (interactive)
+              (slime-oos (slime-read-system-name) "COMPILE-OP" :force t)))
+  (:one-liner "Recompile (but not load) an ASDF system."))
+
+(defun slime-asdf-on-connect ()
+  (slime-eval-async '(swank:swank-require :swank-asdf)))
+
+(defun slime-asdf-init ()
+  (add-hook 'slime-connected-hook 'slime-asdf-on-connect))
+
+(defun slime-asdf-unload ()
+  (remove-hook 'slime-connected-hook 'slime-asdf-on-connect))
+
+(provide 'slime-asdf)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,273 @@
+;;; slime-autodoc.el --- show fancy arglist in echo area
+;;
+;; Authors: Luke Gorrie  <luke at bluetail.com>
+;;          Lawrence Mitchell  <wence at gmx.li>
+;;          Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          and others
+;; 
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-autodoc)))
+;;
+
+(require 'slime-parse)
+
+(defvar slime-use-autodoc-mode t
+  "When non-nil always enable slime-autodoc-mode in slime-mode.")
+
+(defun slime-fontify-string (string)
+  "Fontify STRING as `font-lock-mode' does in Lisp mode."
+  (with-current-buffer (get-buffer-create " *slime-fontify*")
+    (erase-buffer)
+    (if (not (eq major-mode 'lisp-mode))
+        (lisp-mode))
+    (insert string)
+    (let ((font-lock-verbose nil))
+      (font-lock-fontify-buffer))
+    (goto-char (point-min))
+    (when (re-search-forward "===> \\(\\(.\\|\n\\)*\\) <===" nil t)
+      (let ((highlight (match-string 1)))
+        ;; Can't use (replace-match highlight) here -- broken in Emacs 21
+        (delete-region (match-beginning 0) (match-end 0))
+	(slime-insert-propertized '(face highlight) highlight)))
+    (buffer-substring (point-min) (point-max))))
+
+(defun slime-arglist (name)
+  "Show the argument list for NAME."
+  (interactive (list (slime-read-symbol-name "Arglist of: ")))
+  (slime-eval-async 
+   `(swank:arglist-for-echo-area (quote (,name)))
+   (lambda (arglist)
+     (if arglist
+         (message "%s" (slime-fontify-string arglist))
+       (error "Arglist not available")))))
+
+
+
+;;;; Autodocs (automatic context-sensitive help)
+
+(defvar slime-autodoc-mode nil
+  "*When non-nil, print documentation about symbols as the point moves.")
+
+(defvar slime-autodoc-cache-type 'last
+  "*Cache policy for automatically fetched documentation.
+Possible values are:
+ nil  - none.
+ last - cache only the most recently-looked-at symbol's documentation.
+        The values are stored in the variable `slime-autodoc-cache'.
+
+More caching means fewer calls to the Lisp process, but at the risk of
+using outdated information.")
+
+(defvar slime-autodoc-cache nil
+  "Cache variable for when `slime-autodoc-cache-type' is 'last'.
+The value is (SYMBOL-NAME . DOCUMENTATION).")
+
+(defun slime-autodoc-mode (&optional arg)
+  "Enable `slime-autodoc'."
+  (interactive "P")
+  (cond ((< (prefix-numeric-value arg) 0) (setq slime-autodoc-mode nil))
+        (arg (setq slime-autodoc-mode t))
+        (t (setq slime-autodoc-mode (not slime-autodoc-mode))))
+  (if slime-autodoc-mode
+      (progn 
+        (slime-autodoc-start-timer)
+        (add-hook 'pre-command-hook 
+                  'slime-autodoc-pre-command-refresh-echo-area t))
+    (slime-autodoc-stop-timer)))
+
+(defvar slime-autodoc-last-message "")
+
+(defun slime-autodoc ()
+  "Print some apropos information about the code at point, if applicable."
+  (destructuring-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
+    (let ((cached (slime-get-cached-autodoc cache-key)))
+      (if cached 
+          (slime-autodoc-message cached)
+        ;; Asynchronously fetch, cache, and display documentation
+        (slime-eval-async 
+         retrieve-form
+         (with-lexical-bindings (cache-key)
+           (lambda (doc)
+             (let ((doc (if doc (slime-fontify-string doc) "")))
+               (slime-update-autodoc-cache cache-key doc)
+               (slime-autodoc-message doc)))))))))
+
+(defcustom slime-autodoc-use-multiline-p nil
+  "If non-nil, allow long autodoc messages to resize echo area display."
+  :type 'boolean
+  :group 'slime-ui)
+
+(defvar slime-autodoc-message-function 'slime-autodoc-show-message)
+
+(defun slime-autodoc-message (doc)
+  "Display the autodoc documentation string DOC."
+  (funcall slime-autodoc-message-function doc))
+
+(defun slime-autodoc-show-message (doc)
+  (unless slime-autodoc-use-multiline-p
+    (setq doc (slime-oneliner doc)))
+  (setq slime-autodoc-last-message doc)
+  (message "%s" doc))
+
+(defun slime-autodoc-message-dimensions ()
+  "Return the available width and height for pretty printing autodoc
+messages."
+  (cond
+   (slime-autodoc-use-multiline-p 
+    ;; Use the full width of the minibuffer;
+    ;; minibuffer will grow vertically if necessary
+    (values (window-width (minibuffer-window))
+            nil))
+   (t
+    ;; Try to fit everything in one line; we cut off when displaying
+    (values 1000 1))))
+
+(defun slime-autodoc-pre-command-refresh-echo-area ()
+  (unless (string= slime-autodoc-last-message "")
+    (if (slime-autodoc-message-ok-p)
+        (message "%s" slime-autodoc-last-message)
+      (setq slime-autodoc-last-message ""))))
+
+(defun slime-autodoc-thing-at-point ()
+  "Return a cache key and a swank form."
+  (let ((global (slime-autodoc-global-at-point)))
+    (if global
+        (values (slime-qualify-cl-symbol-name global)
+                `(swank:variable-desc-for-echo-area ,global))
+      (multiple-value-bind (operators arg-indices points)
+          (slime-enclosing-form-specs)
+        (values (mapcar* (lambda (designator arg-index)
+                           (cons
+                            (if (symbolp designator)
+                                (slime-qualify-cl-symbol-name designator)
+                              designator)
+                            arg-index))
+                         operators arg-indices)
+                (multiple-value-bind (width height)
+                    (slime-autodoc-message-dimensions)
+                  `(swank:arglist-for-echo-area ',operators
+                                                :arg-indices ',arg-indices
+                                                :print-right-margin ,width
+                                                :print-lines ,height)))))))
+
+(defun slime-autodoc-global-at-point ()
+  "Return the global variable name at point, if any."
+  (when-let (name (slime-symbol-name-at-point))
+    (if (slime-global-variable-name-p name) name)))
+
+(defcustom slime-global-variable-name-regexp "^\\(.*:\\)?\\([*+]\\).+\\2$"
+  "Regexp used to check if a symbol name is a global variable.
+
+Default value assumes +this+ or *that* naming conventions."
+  :type 'regexp
+  :group 'slime)
+
+(defun slime-global-variable-name-p (name)
+  "Is NAME a global variable?
+Globals are recognised purely by *this-naming-convention*."
+  (and (< (length name) 80) ; avoid overflows in regexp matcher
+       (string-match slime-global-variable-name-regexp name)))
+
+(defun slime-get-cached-autodoc (symbol-name)
+  "Return the cached autodoc documentation for SYMBOL-NAME, or nil."
+  (ecase slime-autodoc-cache-type
+    ((nil) nil)
+    ((last)
+     (when (equal (car slime-autodoc-cache) symbol-name)
+       (cdr slime-autodoc-cache)))
+    ((all)
+     (when-let (symbol (intern-soft symbol-name))
+       (get symbol 'slime-autodoc-cache)))))
+
+(defun slime-update-autodoc-cache (symbol-name documentation)
+  "Update the autodoc cache for SYMBOL with DOCUMENTATION.
+Return DOCUMENTATION."
+  (ecase slime-autodoc-cache-type
+    ((nil) nil)
+    ((last)
+     (setq slime-autodoc-cache (cons symbol-name documentation)))
+    ((all)
+     (put (intern symbol-name) 'slime-autodoc-cache documentation)))
+  documentation)
+
+
+;;;;; Asynchronous message idle timer
+
+(defvar slime-autodoc-idle-timer nil
+  "Idle timer for the next autodoc message.")
+
+(defvar slime-autodoc-delay 0.2
+  "*Delay before autodoc messages are fetched and displayed, in seconds.")
+
+(defun slime-autodoc-start-timer ()
+  "(Re)start the timer that prints autodocs every `slime-autodoc-delay' seconds."
+  (interactive)
+  (when slime-autodoc-idle-timer
+    (cancel-timer slime-autodoc-idle-timer))
+  (setq slime-autodoc-idle-timer
+        (run-with-idle-timer slime-autodoc-delay slime-autodoc-delay
+                             'slime-autodoc-timer-hook)))
+
+(defun slime-autodoc-stop-timer ()
+  "Stop the timer that prints autodocs.
+See also `slime-autodoc-start-timer'."
+  (when slime-autodoc-idle-timer
+    (cancel-timer slime-autodoc-idle-timer)
+    (setq slime-autodoc-idle-timer nil)))
+
+(defun slime-autodoc-timer-hook ()
+  "Function to be called after each Emacs becomes idle.
+When `slime-autodoc-mode' is non-nil, print apropos information about
+the symbol at point if applicable."
+  (when (slime-autodoc-message-ok-p)
+    (condition-case err
+        (slime-autodoc)
+      (error
+       (setq slime-autodoc-mode nil)
+       (message "Error: %S; slime-autodoc-mode now disabled." err)))))
+
+(defun slime-autodoc-message-ok-p ()
+  "Return true if printing a message is currently okay (shouldn't
+annoy the user)."
+  (and (or slime-mode (eq major-mode 'slime-repl-mode) 
+           (eq major-mode 'sldb-mode))
+       slime-autodoc-mode
+       (or (null (current-message)) 
+           (string= (current-message) slime-autodoc-last-message))
+       (not executing-kbd-macro)
+       (not (and (boundp 'edebug-active) (symbol-value 'edebug-active)))
+       (not cursor-in-echo-area)
+       (not (active-minibuffer-window))
+       (not (eq (selected-window) (minibuffer-window)))
+       (slime-background-activities-enabled-p)))
+
+
+;;; Initialization
+
+(defun slime-autodoc-init ()
+  (setq slime-echo-arglist-function 'slime-autodoc)
+  (add-hook 'slime-connected-hook 'slime-autodoc-on-connect)
+  (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
+    (add-hook h 'slime-autodoc-maybe-enable)))
+
+(defun slime-autodoc-on-connect ()
+  (slime-eval-async '(swank:swank-require :swank-arglists)))
+
+(defun slime-autodoc-maybe-enable ()
+  (when slime-use-autodoc-mode 
+    (slime-autodoc-mode 1)))
+
+(defun slime-autodoc-unload ()
+  (setq slime-echo-arglist-function 'slime-show-arglist)
+  (remove-hook 'slime-connected-hook 'slime-autodoc-on-connect)
+  (dolist (h '(slime-mode-hook slime-repl-mode-hook sldb-mode-hook))
+    (remove-hook h 'slime-autodoc-maybe-enable)))
+
+(provide 'slime-autodoc)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-banner.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,44 @@
+;;; slime-banner.el -- Persistent header line and startup animation
+;;
+;; Authors: Helmut Eller  <heller at common-lisp.net>
+;;          Luke Gorrie  <luke at synap.se>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path ".../slime/contrib")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-banner)))
+
+(defcustom slime-startup-animation (fboundp 'animate-string)
+   "Enable the startup animation."
+   :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+   :group 'slime-ui)
+
+(defcustom slime-header-line-p (boundp 'header-line-format)
+  "If non-nil, display a header line in Slime buffers."
+  :type 'boolean
+  :group 'slime-repl)
+
+(defun slime-startup-message ()
+  (when slime-header-line-p
+    (setq header-line-format 
+          (format "%s  Port: %s  Pid: %s"
+                  (slime-lisp-implementation-type)
+                  (slime-connection-port (slime-connection))
+                  (slime-pid))))
+  (when (zerop (buffer-size))
+    (let ((welcome (concat "; SLIME " (or (slime-changelog-date) 
+                                          "- ChangeLog file not found"))))
+      (if slime-startup-animation
+          (animate-string welcome 0 0) 
+        (insert welcome)))))
+
+(defun slime-banner-init ()
+  (setq slime-repl-banner-function 'slime-startup-message))
+
+(defun slime-banner-unload ()
+  (setq slime-repl-banner-function 'slime-repl-insert-banner))
+
+(provide 'slime-banner)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-c-p-c.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,202 @@
+;;; slime-c-p-c.el --- ILISP style Compound Prefix Completion
+;;
+;; Authors: Luke Gorrie  <luke at synap.se>
+;;          Edi Weitz  <edi at agharta.de>
+;;          Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de> 
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-c-p-c)))
+;;
+
+
+
+(require 'slime)
+(require 'slime-parse)
+(require 'slime-editing-commands)
+
+(defcustom slime-c-p-c-unambiguous-prefix-p t
+  "If true, set point after the unambigous prefix.
+If false, move point to the end of the inserted text."
+  :type 'boolean
+  :group 'slime-ui)
+
+(defcustom slime-complete-symbol*-fancy nil
+  "Use information from argument lists for DWIM'ish symbol completion."
+  :group 'slime-mode
+  :type 'boolean)
+
+(defun slime-complete-symbol* ()
+  "Expand abbreviations and complete the symbol at point."
+  ;; NB: It is only the name part of the symbol that we actually want
+  ;; to complete -- the package prefix, if given, is just context.
+  (or (slime-maybe-complete-as-filename)
+      (slime-expand-abbreviations-and-complete)))
+
+;; FIXME: factorize
+(defun slime-expand-abbreviations-and-complete ()
+  (let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
+         (beg (move-marker (make-marker) (slime-symbol-start-pos)))
+         (prefix (buffer-substring-no-properties beg end))
+         (completion-result (slime-contextual-completions beg end))
+         (completion-set (first completion-result))
+         (completed-prefix (second completion-result)))
+    (if (null completion-set)
+        (progn (slime-minibuffer-respecting-message
+                "Can't find completion for \"%s\"" prefix)
+               (ding)
+               (slime-complete-restore-window-configuration))
+      ;; some XEmacs issue makes this distinction necessary
+      (cond ((> (length completed-prefix) (- end beg))
+	     (goto-char end)
+	     (insert-and-inherit completed-prefix)
+	     (delete-region beg end)
+	     (goto-char (+ beg (length completed-prefix))))
+	    (t nil))
+      (cond ((and (member completed-prefix completion-set)
+                  (slime-length= completion-set 1))
+             (slime-minibuffer-respecting-message "Sole completion")
+             (when slime-complete-symbol*-fancy
+               (slime-complete-symbol*-fancy-bit))
+             (slime-complete-restore-window-configuration))
+            ;; Incomplete
+            (t
+             (when (member completed-prefix completion-set)
+               (slime-minibuffer-respecting-message 
+                "Complete but not unique"))
+	     (when slime-c-p-c-unambiguous-prefix-p
+	       (let ((unambiguous-completion-length
+		      (loop for c in completion-set
+			    minimizing (or (mismatch completed-prefix c)
+					   (length completed-prefix)))))
+		 (goto-char (+ beg unambiguous-completion-length))))
+             (slime-display-or-scroll-completions completion-set 
+                                                  completed-prefix))))))
+
+(defun slime-complete-symbol*-fancy-bit ()
+  "Do fancy tricks after completing a symbol.
+\(Insert a space or close-paren based on arglist information.)"
+  (let ((arglist (slime-get-arglist (slime-symbol-name-at-point))))
+    (when arglist
+      (let ((args
+             ;; Don't intern these symbols
+             (let ((obarray (make-vector 10 0)))
+               (cdr (read arglist))))
+            (function-call-position-p
+             (save-excursion
+                (backward-sexp)
+                (equal (char-before) ?\())))
+        (when function-call-position-p
+          (if (null args)
+              (insert-and-inherit ")")
+            (insert-and-inherit " ")
+            (when (and slime-space-information-p
+                       (slime-background-activities-enabled-p)
+                       (not (minibuffer-window-active-p (minibuffer-window))))
+              (slime-echo-arglist))))))))
+
+(defun slime-get-arglist (symbol-name)
+  "Return the argument list for SYMBOL-NAME."
+  (slime-eval `(swank:arglist-for-echo-area (quote (,symbol-name)))))
+
+(defun* slime-contextual-completions (beg end) 
+  "Return a list of completions of the token from BEG to END in the
+current buffer."
+  (let ((token (buffer-substring-no-properties beg end)))
+    (cond
+     ((and (< beg (point-max))
+               (string= (buffer-substring-no-properties beg (1+ beg)) ":"))
+      ;; Contextual keyword completion
+      (multiple-value-bind (operator-names arg-indices points)
+          (save-excursion 
+            (goto-char beg)
+            (slime-enclosing-form-specs))
+        (when operator-names
+          (let ((completions 
+                 (slime-completions-for-keyword operator-names token
+                                                arg-indices)))
+            (when (first completions)
+              (return-from slime-contextual-completions completions))
+            ;; If no matching keyword was found, do regular symbol
+            ;; completion.
+            ))))
+     ((and (> beg 2)
+           (string= (buffer-substring-no-properties (- beg 2) beg) "#\\"))
+      ;; Character name completion
+      (return-from slime-contextual-completions
+        (slime-completions-for-character token))))
+    ;; Regular symbol completion
+    (slime-completions token)))
+
+(defun slime-completions (prefix)
+  (slime-eval `(swank:completions ,prefix ',(slime-current-package))))
+
+(defun slime-completions-for-keyword (operator-designator prefix
+                                                          arg-indices)
+  (slime-eval `(swank:completions-for-keyword ',operator-designator
+					      ,prefix
+					      ',arg-indices)))
+
+(defun slime-completions-for-character (prefix)
+  (slime-eval `(swank:completions-for-character ,prefix)))
+
+
+;;; Complete form
+
+(defun slime-complete-form ()
+  "Complete the form at point.  
+This is a superset of the functionality of `slime-insert-arglist'."
+  (interactive)
+  ;; Find the (possibly incomplete) form around point.
+  (let ((form-string (slime-incomplete-form-at-point)))
+    (let ((result (slime-eval `(swank:complete-form ',form-string))))
+      (if (eq result :not-available)
+          (error "Could not generate completion for the form `%s'" form-string)
+          (progn
+            (just-one-space)
+            (save-excursion
+              ;; SWANK:COMPLETE-FORM always returns a closing
+              ;; parenthesis; but we only want to insert one if it's
+              ;; really necessary (thinking especially of paredit.el.)
+              (insert (substring result 0 -1))
+              (let ((slime-close-parens-limit 1))
+                (slime-close-all-parens-in-sexp)))
+            (save-excursion
+              (backward-up-list 1)
+              (indent-sexp)))))))
+
+;;; Initialization
+
+(defvar slime-c-p-c-init-undo-stack nil)
+
+(defun slime-c-p-c-init ()
+  ;; save current state for unload
+  (push 
+   `(progn
+      (setq slime-complete-symbol-function ',slime-complete-symbol-function)
+      (remove-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
+      (define-key slime-mode-map "\C-c\C-s"
+	',(lookup-key slime-mode-map "\C-c\C-s"))
+      (define-key slime-repl-mode-map "\C-c\C-s"
+	',(lookup-key slime-repl-mode-map "\C-c\C-s")))
+   slime-c-p-c-init-undo-stack)
+  (setq slime-complete-symbol-function 'slime-complete-symbol*)
+  (add-hook 'slime-connected-hook 'slime-c-p-c-on-connect)
+  (define-key slime-mode-map "\C-c\C-s" 'slime-complete-form)
+  (define-key slime-repl-mode-map "\C-c\C-s" 'slime-complete-form))
+
+(defun slime-c-p-c-on-connect ()
+  (slime-eval-async '(swank:swank-require :swank-arglists)))
+
+(defun slime-c-p-c-unload ()
+  (while slime-c-p-c-init-undo-stack
+    (eval (pop slime-c-p-c-init-undo-stack))))
+
+(provide 'slime-c-p-c)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,189 @@
+;;; slime-editing-commands.el -- editing commands whithout server interaction
+;;
+;; Authors: Thomas F. Burdick  <tfb at OCF.Berkeley.EDU>
+;;          Luke Gorrie  <luke at synap.se>
+;;          Bill Clementson <billclem at gmail.com>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          and others
+;; 
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-editing-commands)))
+;;
+
+(defun slime-beginning-of-defun ()
+  (interactive)
+  (if (and (boundp 'slime-repl-input-start-mark)
+           slime-repl-input-start-mark)
+      (slime-repl-beginning-of-defun)
+      (beginning-of-defun)))
+
+(defun slime-end-of-defun ()
+  (interactive)
+  (if (and (boundp 'slime-repl-input-end-mark)
+           slime-repl-input-end-mark)
+      (slime-repl-end-of-defun)
+      (end-of-defun)))
+
+(defvar slime-comment-start-regexp
+  "\\(\\(^\\|[^\n\\\\]\\)\\([\\\\][\\\\]\\)*\\);+[ \t]*"
+  "Regexp to match the start of a comment.")
+
+(defun slime-beginning-of-comment ()
+  "Move point to beginning of comment.
+If point is inside a comment move to beginning of comment and return point.
+Otherwise leave point unchanged and return NIL."
+  (let ((boundary (point)))
+    (beginning-of-line)
+    (cond ((re-search-forward slime-comment-start-regexp boundary t)
+           (point))
+          (t (goto-char boundary) 
+             nil))))
+
+(defun slime-close-all-parens-in-sexp (&optional region)
+  "Balance parentheses of open s-expressions at point.
+Insert enough right parentheses to balance unmatched left parentheses.
+Delete extra left parentheses.  Reformat trailing parentheses 
+Lisp-stylishly.
+
+If REGION is true, operate on the region. Otherwise operate on
+the top-level sexp before point."
+  (interactive "P")
+  (let ((sexp-level 0)
+        point)
+    (save-excursion
+      (save-restriction
+        (when region
+          (narrow-to-region (region-beginning) (region-end))
+          (goto-char (point-max)))
+        ;; skip over closing parens, but not into comment
+        (skip-chars-backward ") \t\n")
+        (when (slime-beginning-of-comment)
+          (forward-line)
+          (skip-chars-forward " \t"))
+        (setq point (point))
+        ;; count sexps until either '(' or comment is found at first column
+        (while (and (not (looking-at "^[(;]"))
+                  (ignore-errors (backward-up-list 1) t))
+          (incf sexp-level))))
+    (when (> sexp-level 0)
+      ;; insert correct number of right parens
+      (goto-char point)
+      (dotimes (i sexp-level) (insert ")"))
+      ;; delete extra right parens
+      (setq point (point))
+      (skip-chars-forward " \t\n)")
+      (skip-chars-backward " \t\n")
+      (let* ((deleted-region     (delete-and-extract-region point (point)))
+             (deleted-text       (substring-no-properties deleted-region))
+             (prior-parens-count (count ?\) deleted-text)))
+        ;; Remember: we always insert as many parentheses as necessary
+        ;; and only afterwards delete the superfluously-added parens.
+        (when slime-close-parens-limit
+          (let ((missing-parens (- sexp-level prior-parens-count
+                                   slime-close-parens-limit)))
+            (dotimes (i (max 0 missing-parens))
+              (delete-char -1))))))))
+
+(defvar slime-close-parens-limit nil
+  "Maxmimum parens for `slime-close-all-sexp' to insert. NIL
+means to insert as many parentheses as necessary to correctly
+close the form.")
+
+(defun slime-insert-balanced-comments (arg)
+  "Insert a set of balanced comments around the s-expression
+containing the point.  If this command is invoked repeatedly
+\(without any other command occurring between invocations), the
+comment progressively moves outward over enclosing expressions.
+If invoked with a positive prefix argument, the s-expression arg
+expressions out is enclosed in a set of balanced comments."
+  (interactive "*p")
+  (save-excursion
+    (when (eq last-command this-command)
+      (when (search-backward "#|" nil t)
+        (save-excursion
+          (delete-char 2)
+          (while (and (< (point) (point-max)) (not (looking-at " *|#")))
+            (forward-sexp))
+          (replace-match ""))))
+    (while (> arg 0)
+      (backward-char 1)
+      (cond ((looking-at ")") (incf arg))
+            ((looking-at "(") (decf arg))))
+    (insert "#|")
+    (forward-sexp)
+    (insert "|#")))
+
+(defun slime-remove-balanced-comments ()
+  "Remove a set of balanced comments enclosing point."
+  (interactive "*")
+  (save-excursion
+    (when (search-backward "#|" nil t)
+      (delete-char 2)
+      (while (and (< (point) (point-max)) (not (looking-at " *|#")))
+      (forward-sexp))
+      (replace-match ""))))
+
+
+;; SLIME-CLOSE-PARENS-AT-POINT is obsolete:
+
+;; It doesn't work correctly on the REPL, because there
+;; BEGINNING-OF-DEFUN-FUNCTION and END-OF-DEFUN-FUNCTION is bound to
+;; SLIME-REPL-MODE-BEGINNING-OF-DEFUN (and
+;; SLIME-REPL-MODE-END-OF-DEFUN respectively) which compromises the
+;; way how they're expect to work (i.e. END-OF-DEFUN does not signal
+;; an UNBOUND-PARENTHESES error.)
+
+;; Use SLIME-CLOSE-ALL-PARENS-IN-SEXP instead.
+
+;; (defun slime-close-parens-at-point ()
+;;   "Close parenthesis at point to complete the top-level-form.  Simply
+;; inserts ')' characters at point until `beginning-of-defun' and
+;; `end-of-defun' execute without errors, or `slime-close-parens-limit'
+;; is exceeded."
+;;   (interactive)
+;;   (loop for i from 1 to slime-close-parens-limit
+;;         until (save-excursion
+;;                 (slime-beginning-of-defun)
+;;                 (ignore-errors (slime-end-of-defun) t))
+;;         do (insert ")")))
+
+(defun slime-reindent-defun (&optional force-text-fill)
+  "Reindent the current defun, or refill the current paragraph.
+If point is inside a comment block, the text around point will be
+treated as a paragraph and will be filled with `fill-paragraph'.
+Otherwise, it will be treated as Lisp code, and the current defun
+will be reindented.  If the current defun has unbalanced parens,
+an attempt will be made to fix it before reindenting.
+
+When given a prefix argument, the text around point will always
+be treated as a paragraph.  This is useful for filling docstrings."
+  (interactive "P")
+  (save-excursion
+    (if (or force-text-fill (slime-beginning-of-comment))
+        (fill-paragraph nil)
+      (let ((start (progn (unless (or (and (zerop (current-column))
+                                           (eq ?\( (char-after)))
+                                      (and slime-repl-input-start-mark
+                                           (slime-repl-at-prompt-start-p)))
+                            (slime-beginning-of-defun))
+                          (point)))
+            (end (ignore-errors (slime-end-of-defun) (point))))
+        (unless end
+          (forward-paragraph)
+          (slime-close-all-parens-in-sexp)
+          (slime-end-of-defun)
+          (setf end (point)))
+        (indent-region start end nil)))))
+
+(defun slime-editing-commands-init ()
+  (define-key slime-mode-map "\M-\C-a"  'slime-beginning-of-defun)
+  (define-key slime-mode-map "\M-\C-e"  'slime-end-of-defun)
+  (define-key slime-mode-map "\C-c\M-q" 'slime-reindent-defun))
+
+(provide 'slime-editing-commands)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy-inspector.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,28 @@
+;;; slime-fancy-inspector.el --- Fancy inspector for CLOS objects
+;;
+;; Author: Marco Baringer <mb at bese.it> and others
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-fancy-inspector)))
+;;   (add-hook 'slime-connected-hook 'slime-install-fancy-inspector)
+
+(defun slime-install-fancy-inspector ()
+  (slime-eval-async '(swank:swank-require :swank-fancy-inspector)
+		    (lambda (_) 
+		      (slime-eval-async '(swank:fancy-inspector-init)))))
+
+(defun slime-deinstall-fancy-inspector ()
+  (slime-eval-async '(swank:fancy-inspector-unload)))
+
+(defun slime-fancy-inspector-init ()
+  (add-hook 'slime-connected-hook 'slime-install-fancy-inspector))
+
+(defun slime-fancy-inspector-unload ()
+  (remove-hook 'slime-connected-hook 'slime-install-fancy-inspector))
+
+(provide 'slime-fancy-inspector)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fancy.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,74 @@
+;;; slime-fancy.el --- Load and init some fancy SLIME contribs
+;;
+;; Authors: Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;; 
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-fancy)))
+;;
+;; We load all SLIME contribs that are currently working,
+;; and which only "upgrade" the behavior of SLIME in some way.
+;; This includes:
+;;   * Adding new commands, keybindings, menu items
+;;   * Making things clickable that would otherwise be just plain text
+
+;; Better arglist display, can be turned off by customization.
+(require 'slime-autodoc)
+(slime-autodoc-init)
+
+;; Adds new commands and installs compound-prefix-completion as
+;; default completion command.  Behaves similar to standard Emacs
+;; completion, unless dashes are present. --mkoeppe
+(require 'slime-c-p-c)
+(slime-c-p-c-init)
+
+;; Just adds commands.  (Well, shadows commands in lisp-mode-map)
+(require 'slime-editing-commands)
+(slime-editing-commands-init)
+
+;; Makes the inspector fancier.
+(require 'slime-fancy-inspector)
+(slime-fancy-inspector-init)
+
+;; Just adds the command C-c M-i.  We do not make fuzzy completion the
+;; default completion invoked by TAB. --mkoeppe
+(require 'slime-fuzzy)
+(slime-fuzzy-init)
+
+;; Do not activate slime-highlighting-edits by default, as it's easier
+;; to explictly activate it (if a user really wants it) than to explictly
+;; deactivate it once it got globally enabled. -TCR.
+(require 'slime-highlight-edits)
+;(slime-highlight-edits-init)
+
+;; Load slime-presentations even though they seem to be a
+;; controversial feature, as they can be easily turned off by
+;; customizing swank:*record-repl-results*. --mkoeppe
+(require 'slime-presentations)
+(slime-presentations-init)
+
+;;; Do not load slime-presentation-streams, as this is an experimental
+;;; feature that installs patches into some Lisps. --mkoeppe
+;;(require 'slime-presentation-streams)
+
+(require 'slime-scratch)
+(slime-scratch-init)
+
+;;; Do not load slime-typeout-frame, as simply loading causes display of a
+;;; typeout frame, which cannot be turned off. --mkoeppe
+;;(require 'slime-typeout-frame)
+
+;; Just adds commands.
+(when (locate-library "tree-widget")
+  (require 'slime-xref-browser))
+
+;; Puts clickable references to documentation into SBCL errors.
+(require 'slime-references)
+(slime-references-init)
+
+(provide 'slime-fancy)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,598 @@
+;;; slime-fuzzy.el --- fuzzy symbol completion
+;;
+;; Authors: Brian Downing <bdowning at lavos.net>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          Attila Lendvai <attila.lendvai at gmail.com>
+;;          and others
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-fuzzy)))
+;;
+
+
+;;; Code
+
+(defcustom slime-fuzzy-completion-in-place t
+  "When non-NIL the fuzzy symbol completion is done in place as
+opposed to moving the point to the completion buffer."
+  :group 'slime-mode
+  :type 'boolean)
+
+(defcustom slime-fuzzy-completion-limit 300
+  "Only return and present this many symbols from swank."
+  :group 'slime-mode
+  :type 'integer)
+
+(defcustom slime-fuzzy-completion-time-limit-in-msec 1500
+  "Limit the time spent (given in msec) in swank while gathering comletitions.
+\(NOTE: currently it's rounded up the nearest second)"
+  :group 'slime-mode
+  :type 'integer)
+
+(defvar slime-fuzzy-target-buffer nil
+  "The buffer that is the target of the completion activities.")
+(defvar slime-fuzzy-saved-window-configuration nil
+  "The saved window configuration before the fuzzy completion
+buffer popped up.")
+(defvar slime-fuzzy-start nil
+  "The beginning of the completion slot in the target buffer.
+This is a non-advancing marker.")
+(defvar slime-fuzzy-end nil
+  "The end of the completion slot in the target buffer.
+This is an advancing marker.")
+(defvar slime-fuzzy-original-text nil
+  "The original text that was in the completion slot in the
+target buffer.  This is what is put back if completion is
+aborted.")
+(defvar slime-fuzzy-text nil
+  "The text that is currently in the completion slot in the
+target buffer.  If this ever doesn't match, the target buffer has
+been modified and we abort without touching it.")
+(defvar slime-fuzzy-first nil
+  "The position of the first completion in the completions buffer.
+The descriptive text and headers are above this.")
+(defvar slime-fuzzy-last nil
+    "The position of the last completion in the completions buffer.
+If the time limit has exhausted during generation possible completion
+choices inside SWANK, an indication is printed below this.")
+(defvar slime-fuzzy-current-completion nil
+  "The current completion object.  If this is the same before and
+after point moves in the completions buffer, the text is not
+replaced in the target for efficiency.")
+(defvar slime-fuzzy-current-completion-overlay nil
+  "The overlay representing the current completion in the completion
+buffer. This is used to hightlight the text.")
+
+;;;;;;; slime-target-buffer-fuzzy-completions-mode
+;; NOTE: this mode has to be able to override key mappings in slime-mode
+
+;; FIXME: clean this up
+
+(defun mimic-key-bindings (from-keymap to-keymap bindings-or-operation operation)
+  "Iterate on BINDINGS-OR-OPERATION. If an element is a symbol then
+try to look it up (as an operation) in FROM-KEYMAP. Non symbols are taken
+as default key bindings when none to be mimiced was found in FROM-KEYMAP.
+Set the resulting list of keys in TO-KEYMAP to OPERATION."
+  (let ((mimic-keys nil)
+        (direct-keys nil))
+    (dolist (key-or-operation bindings-or-operation)
+      (if (symbolp key-or-operation)
+          (setf mimic-keys (append mimic-keys (where-is-internal key-or-operation from-keymap nil t)))
+          (push key-or-operation direct-keys)))
+    (dolist (key (or mimic-keys direct-keys))
+      (define-key to-keymap key operation))))
+
+(defvar slime-target-buffer-fuzzy-completions-map
+  (let* ((map (make-sparse-keymap)))
+    (flet ((remap (keys to)
+             (mimic-key-bindings global-map map keys to)))
+      
+      (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)
+
+      (remap (list 'slime-fuzzy-indent-and-complete-symbol
+                   'slime-indent-and-complete-symbol
+                   (kbd "<tab>"))
+             'slime-fuzzy-select-or-update-completions)
+      (remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)
+      (remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)
+      (remap (list 'isearch-forward (kbd "C-s"))
+             (lambda ()
+               (interactive)
+               (select-window (get-buffer-window (slime-get-fuzzy-buffer)))
+               (call-interactively 'isearch-forward)))
+
+      ;; some unconditional direct bindings
+      (dolist (key (list (kbd "<return>") (kbd "RET") (kbd "<SPC>") "(" ")" "[" "]"))
+        (define-key map key 'slime-fuzzy-select-and-process-event-in-target-buffer)))
+    map
+    )
+  "Keymap for slime-target-buffer-fuzzy-completions-mode. This will override the key
+bindings in the target buffer temporarily during completion.")
+
+;; Make sure slime-fuzzy-target-buffer-completions-mode's map is
+;; before everything else.
+(setf minor-mode-map-alist
+      (stable-sort minor-mode-map-alist
+                   (lambda (a b)
+                     (eq a 'slime-fuzzy-target-buffer-completions-mode))
+                   :key #'car))
+
+
+(define-minor-mode slime-fuzzy-target-buffer-completions-mode
+  "This minor mode is intented to override key bindings during fuzzy
+completions in the target buffer. Most of the bindings will do an implicit select
+in the completion window and let the keypress be processed in the target buffer."
+  nil
+  nil
+  slime-target-buffer-fuzzy-completions-map)
+
+(add-to-list 'minor-mode-alist
+             '(slime-fuzzy-target-buffer-completions-mode
+               " Fuzzy Target Buffer Completions"))
+
+(define-derived-mode slime-fuzzy-completions-mode 
+  fundamental-mode "Fuzzy Completions"
+  "Major mode for presenting fuzzy completion results.
+
+When you run `slime-fuzzy-complete-symbol', the symbol token at
+point is completed using the Fuzzy Completion algorithm; this
+means that the token is taken as a sequence of characters and all
+the various possibilities that this sequence could meaningfully
+represent are offered as selectable choices, sorted by how well
+they deem to be a match for the token. (For instance, the first
+choice of completing on \"mvb\" would be \"multiple-value-bind\".)
+
+Therefore, a new buffer (*Fuzzy Completions*) will pop up that
+contains the different completion choices. Simultaneously, a
+special minor-mode will be temporarily enabled in the original
+buffer where you initiated fuzzy completion (also called the
+``target buffer'') in order to navigate through the *Fuzzy
+Completions* buffer without leaving.
+
+With focus in *Fuzzy Completions*:
+  Type `n' and `p' (`UP', `DOWN') to navigate between completions.
+  Type `RET' or `TAB' to select the completion near point. 
+  Type `q' to abort.
+
+With focus in the target buffer:
+  Type `UP' and `DOWN' to navigate between completions.
+  Type a character that does not constitute a symbol name
+  to insert the current choice and then that character (`(', `)',
+  `SPACE', `RET'.) Use `TAB' to simply insert the current choice.
+  Use C-g to abort.
+
+Alternatively, you can click <mouse-2> on a completion to select it.
+
+
+Complete listing of keybindings within the target buffer:
+
+\\<slime-target-buffer-fuzzy-completions-map>\
+\\{slime-target-buffer-fuzzy-completions-map}
+
+Complete listing of keybindings with *Fuzzy Completions*:
+
+\\<slime-fuzzy-completions-map>\
+\\{slime-fuzzy-completions-map}"
+  (use-local-map slime-fuzzy-completions-map))
+
+(defvar slime-fuzzy-completions-map  
+  (let* ((map (make-sparse-keymap)))
+    (flet ((remap (keys to)
+             (mimic-key-bindings global-map map keys to)))
+      (remap (list 'keyboard-quit (kbd "C-g")) 'slime-fuzzy-abort)
+      (define-key map "q" 'slime-fuzzy-abort)
+    
+      (remap (list 'previous-line (kbd "<up>")) 'slime-fuzzy-prev)
+      (remap (list 'next-line (kbd "<down>")) 'slime-fuzzy-next)
+    
+      (define-key map "n" 'slime-fuzzy-next)
+      (define-key map "\M-n" 'slime-fuzzy-next)
+    
+      (define-key map "p" 'slime-fuzzy-prev)
+      (define-key map "\M-p" 'slime-fuzzy-prev)
+    
+      (define-key map "\d" 'scroll-down)
+
+      (remap (list 'slime-fuzzy-indent-and-complete-symbol
+                   'slime-indent-and-complete-symbol
+                   (kbd "<tab>"))
+             'slime-fuzzy-select)
+
+      (define-key map (kbd "<mouse-2>") 'slime-fuzzy-select/mouse))
+    
+      (define-key map (kbd "RET") 'slime-fuzzy-select)
+      (define-key map (kbd "<SPC>") 'slime-fuzzy-select)
+    
+    map)
+  "Keymap for slime-fuzzy-completions-mode when in the completion buffer.")
+
+(defun slime-fuzzy-completions (prefix &optional default-package)
+  "Get the list of sorted completion objects from completing
+`prefix' in `package' from the connected Lisp."
+  (let ((prefix (etypecase prefix
+		  (symbol (symbol-name prefix))
+		  (string prefix))))
+    (slime-eval `(swank:fuzzy-completions ,prefix 
+                                          ,(or default-package
+                                               (slime-find-buffer-package)
+                                               (slime-current-package))
+                  :limit ,slime-fuzzy-completion-limit
+                  :time-limit-in-msec ,slime-fuzzy-completion-time-limit-in-msec))))
+
+(defun slime-fuzzy-selected (prefix completion)
+  "Tell the connected Lisp that the user selected completion
+`completion' as the completion for `prefix'."
+  (let ((no-properties (copy-sequence prefix)))
+    (set-text-properties 0 (length no-properties) nil no-properties)
+    (slime-eval `(swank:fuzzy-completion-selected ,no-properties 
+                                                  ',completion))))
+
+(defun slime-fuzzy-indent-and-complete-symbol ()
+  "Indent the current line and perform fuzzy symbol completion.  First
+indent the line. If indenting doesn't move point, complete the
+symbol. If there's no symbol at the point, show the arglist for the
+most recently enclosed macro or function."
+  (interactive)
+  (let ((pos (point)))
+    (unless (get-text-property (line-beginning-position) 'slime-repl-prompt)
+      (lisp-indent-line))
+    (when (= pos (point))
+      (cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))
+             (slime-fuzzy-complete-symbol))
+            ((memq (char-before) '(?\t ?\ ))
+             (slime-echo-arglist))))))
+
+(defun* slime-fuzzy-complete-symbol ()
+  "Fuzzily completes the abbreviation at point into a symbol."
+  (interactive)
+  (when (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
+    (return-from slime-fuzzy-complete-symbol 
+      (if slime-when-complete-filename-expand
+          (comint-replace-by-expanded-filename)
+        (comint-dynamic-complete-as-filename))))
+  (let* ((end (move-marker (make-marker) (slime-symbol-end-pos)))
+         (beg (move-marker (make-marker) (slime-symbol-start-pos)))
+         (prefix (buffer-substring-no-properties beg end)))
+    (destructuring-bind (completion-set interrupted-p)
+        (slime-fuzzy-completions prefix)
+      (if (null completion-set)
+          (progn (slime-minibuffer-respecting-message
+                  "Can't find completion for \"%s\"" prefix)
+                 (ding)
+                 (slime-fuzzy-done))
+          (goto-char end)
+          (cond ((slime-length= completion-set 1)
+                 (insert-and-inherit (caar completion-set)) ; insert completed string
+                 (delete-region beg end)
+                 (goto-char (+ beg (length (caar completion-set))))
+                 (slime-minibuffer-respecting-message "Sole completion")
+                 (slime-fuzzy-done))
+                ;; Incomplete
+                (t
+                 (slime-minibuffer-respecting-message "Complete but not unique")
+                 (slime-fuzzy-choices-buffer completion-set interrupted-p beg end)))))))
+
+
+(defun slime-get-fuzzy-buffer ()
+  (get-buffer-create "*Fuzzy Completions*"))
+
+(defvar slime-fuzzy-explanation
+  "For help on how the use this buffer, see `slime-fuzzy-completions-mode'.
+
+Flags: boundp fboundp generic-function class macro special-operator package
+\n"
+  "The explanation that gets inserted at the beginning of the
+*Fuzzy Completions* buffer.")
+
+(defun slime-fuzzy-insert-completion-choice (completion max-length)
+  "Inserts the completion object `completion' as a formatted
+completion choice into the current buffer, and mark it with the
+proper text properties."
+  (let ((start (point))
+        (symbol-name (first completion))
+        (score (second completion))
+        (chunks (third completion))
+        (flags (fourth completion)))
+    (insert symbol-name)
+    (let ((end (point)))
+      (dolist (chunk chunks)
+        (put-text-property (+ start (first chunk)) 
+                           (+ start (first chunk) 
+                              (length (second chunk)))
+                           'face 'bold))
+      (put-text-property start (point) 'mouse-face 'highlight)
+      (dotimes (i (- max-length (- end start)))
+        (insert " "))
+      (insert (format " %s%s%s%s%s%s%s %8.2f"
+                      (if (member :boundp flags) "b" "-")
+                      (if (member :fboundp flags) "f" "-")
+                      (if (member :generic-function flags) "g" "-")
+                      (if (member :class flags) "c" "-")
+                      (if (member :macro flags) "m" "-")
+                      (if (member :special-operator flags) "s" "-")
+                      (if (member :package flags) "p" "-")
+                      score))
+      (insert "\n")
+      (put-text-property start (point) 'completion completion))))
+
+(defun slime-fuzzy-insert (text)
+  "Inserts `text' into the target buffer in the completion slot.
+If the buffer has been modified in the meantime, abort the
+completion process.  Otherwise, update all completion variables
+so that the new text is present."
+  (with-current-buffer slime-fuzzy-target-buffer
+    (cond 
+     ((not (string-equal slime-fuzzy-text 
+                         (buffer-substring slime-fuzzy-start
+                                           slime-fuzzy-end)))
+      (slime-fuzzy-done)
+      (beep)
+      (message "Target buffer has been modified!"))
+     (t
+      (goto-char slime-fuzzy-start)
+      (delete-region slime-fuzzy-start slime-fuzzy-end)
+      (insert-and-inherit text)
+      (setq slime-fuzzy-text text)
+      (goto-char slime-fuzzy-end)))))
+
+(defun slime-fuzzy-choices-buffer (completions interrupted-p start end)
+  "Creates (if neccessary), populates, and pops up the *Fuzzy
+Completions* buffer with the completions from `completions' and
+the completion slot in the current buffer bounded by `start' and
+`end'.  This saves the window configuration before popping the
+buffer so that it can possibly be restored when the user is
+done."
+  (let ((new-completion-buffer (not slime-fuzzy-target-buffer)))
+    (when new-completion-buffer
+      (setq slime-fuzzy-saved-window-configuration
+            (current-window-configuration)))
+    (slime-fuzzy-enable-target-buffer-completions-mode)
+    (setq slime-fuzzy-target-buffer (current-buffer))
+    (setq slime-fuzzy-start (move-marker (make-marker) start))
+    (setq slime-fuzzy-end (move-marker (make-marker) end))
+    (set-marker-insertion-type slime-fuzzy-end t)
+    (setq slime-fuzzy-original-text (buffer-substring start end))
+    (setq slime-fuzzy-text slime-fuzzy-original-text)
+    (slime-fuzzy-fill-completions-buffer completions interrupted-p)
+    (pop-to-buffer (slime-get-fuzzy-buffer))
+    (when new-completion-buffer
+      ;; Hook to nullify window-config restoration if the user changes
+      ;; the window configuration himself.
+      (when (boundp 'window-configuration-change-hook)
+        (add-hook 'window-configuration-change-hook
+                  'slime-fuzzy-window-configuration-change))
+      (add-local-hook 'kill-buffer-hook 'slime-fuzzy-abort)
+      (setq buffer-quit-function 'slime-fuzzy-abort)) ; M-Esc Esc
+    (when slime-fuzzy-completion-in-place
+      ;; switch back to the original buffer
+      (switch-to-buffer-other-window slime-fuzzy-target-buffer))))
+
+(defun slime-fuzzy-fill-completions-buffer (completions interrupted-p)
+  "Erases and fills the completion buffer with the given completions."
+  (with-current-buffer (slime-get-fuzzy-buffer)
+    (setq buffer-read-only nil)
+    (erase-buffer)
+    (slime-fuzzy-completions-mode)
+    (insert slime-fuzzy-explanation)
+    (let ((max-length 12))
+      (dolist (completion completions)
+        (setf max-length (max max-length (length (first completion)))))
+
+      (insert "Completion:")
+      (dotimes (i (- max-length 10)) (insert " "))
+      ;;     Flags:  Score:
+      ;; ... ------- --------
+      ;;     bfgcmsp 
+      (insert "Flags:  Score:\n")
+      (dotimes (i max-length) (insert "-"))
+      (insert " ------- --------\n")
+      (setq slime-fuzzy-first (point))
+
+      (dolist (completion completions)
+        (setq slime-fuzzy-last (point)) ; will eventually become the last entry
+        (slime-fuzzy-insert-completion-choice completion max-length))
+
+      (when interrupted-p
+        (insert "...\n")
+        (insert "[Interrupted: time limit exhausted]"))
+
+      (setq buffer-read-only t))
+    (setq slime-fuzzy-current-completion
+          (caar completions))
+    (goto-char 0)
+    (slime-fuzzy-next)))
+
+(defun slime-fuzzy-enable-target-buffer-completions-mode ()
+  "Store the target buffer's local map, so that we can restore it."
+  (unless slime-fuzzy-target-buffer-completions-mode
+;    (slime-log-event "Enabling target buffer completions mode")
+    (slime-fuzzy-target-buffer-completions-mode 1)))
+
+(defun slime-fuzzy-disable-target-buffer-completions-mode ()
+  "Restores the target buffer's local map when completion is finished."
+  (when slime-fuzzy-target-buffer-completions-mode
+;    (slime-log-event "Disabling target buffer completions mode")
+    (slime-fuzzy-target-buffer-completions-mode 0)))
+
+(defun slime-fuzzy-insert-from-point ()
+  "Inserts the completion that is under point in the completions
+buffer into the target buffer.  If the completion in question had
+already been inserted, it does nothing."
+  (with-current-buffer (slime-get-fuzzy-buffer)
+    (let ((current-completion (get-text-property (point) 'completion)))
+      (when (and current-completion
+                 (not (eq slime-fuzzy-current-completion 
+                          current-completion)))
+        (slime-fuzzy-insert 
+         (first (get-text-property (point) 'completion)))
+        (setq slime-fuzzy-current-completion
+              current-completion)))))
+
+(defun slime-fuzzy-post-command-hook ()
+  "The post-command-hook for the *Fuzzy Completions* buffer.
+This makes sure the completion slot in the target buffer matches
+the completion that point is on in the completions buffer."
+  (condition-case err
+      (when slime-fuzzy-target-buffer
+        (slime-fuzzy-insert-from-point))
+    (error
+     ;; Because this is called on the post-command-hook, we mustn't let
+     ;; errors propagate.
+     (message "Error in slime-fuzzy-post-command-hook: %S" err))))
+
+(defun slime-fuzzy-next ()
+  "Moves point directly to the next completion in the completions
+buffer."
+  (interactive)
+  (with-current-buffer (slime-get-fuzzy-buffer)
+    (slime-fuzzy-dehighlight-current-completion)
+    (let ((point (next-single-char-property-change (point) 'completion nil slime-fuzzy-last)))
+      (set-window-point (get-buffer-window (current-buffer)) point)
+      (goto-char point))
+    (slime-fuzzy-highlight-current-completion)))
+
+(defun slime-fuzzy-prev ()
+  "Moves point directly to the previous completion in the
+completions buffer."
+  (interactive)
+  (with-current-buffer (slime-get-fuzzy-buffer)
+    (slime-fuzzy-dehighlight-current-completion)
+    (let ((point (previous-single-char-property-change (point) 'completion nil slime-fuzzy-first)))
+      (set-window-point (get-buffer-window (current-buffer)) point)
+      (goto-char point))
+    (slime-fuzzy-highlight-current-completion)))
+
+(defun slime-fuzzy-dehighlight-current-completion ()
+  "Restores the original face for the current completion."
+  (when slime-fuzzy-current-completion-overlay
+    (overlay-put slime-fuzzy-current-completion-overlay 'face 'nil)))
+
+(defun slime-fuzzy-highlight-current-completion ()
+  "Highlights the current completion, so that the user can see it on the screen."
+  (let ((pos (point)))
+    (setq slime-fuzzy-current-completion-overlay 
+          (make-overlay (point) (1- (search-forward " "))
+                        (current-buffer) t nil))
+    (overlay-put slime-fuzzy-current-completion-overlay 'face 'secondary-selection)
+    (goto-char pos)))
+
+(defun slime-fuzzy-abort ()
+  "Aborts the completion process, setting the completions slot in
+the target buffer back to its original contents."
+  (interactive)
+  (when slime-fuzzy-target-buffer
+    (slime-fuzzy-done)))
+
+(defun slime-fuzzy-select ()
+  "Selects the current completion, making sure that it is inserted 
+into the target buffer.  This tells the connected Lisp what completion
+was selected."
+  (interactive)
+  (when slime-fuzzy-target-buffer
+    (with-current-buffer (slime-get-fuzzy-buffer)
+      (let ((completion (get-text-property (point) 'completion)))
+        (when completion
+          (slime-fuzzy-insert (first completion))
+          (slime-fuzzy-selected slime-fuzzy-original-text
+                                completion)
+          (slime-fuzzy-done))))))
+
+(defun slime-fuzzy-select-or-update-completions ()
+  "If there were no changes since the last time fuzzy completion was started
+this function will select the current completion. Otherwise refreshes the completion
+list based on the changes made."
+  (interactive)
+;  (slime-log-event "Selecting or updating completions")
+  (if (string-equal slime-fuzzy-original-text 
+                    (buffer-substring slime-fuzzy-start
+                                      slime-fuzzy-end))
+      (slime-fuzzy-select)
+      (slime-fuzzy-complete-symbol)))
+
+(defun slime-fuzzy-process-event-in-completions-buffer ()
+  "Simply processes the event in the target buffer"
+  (interactive)
+  (with-current-buffer (slime-get-fuzzy-buffer)
+    (push last-input-event unread-command-events)))
+
+(defun slime-fuzzy-select-and-process-event-in-target-buffer ()
+ "Selects the current completion, making sure that it is inserted
+into the target buffer and processes the event in the target buffer."
+ (interactive)
+; (slime-log-event "Selecting and processing event in target buffer")
+ (when slime-fuzzy-target-buffer
+   (let ((buff slime-fuzzy-target-buffer))
+     (slime-fuzzy-select)
+     (with-current-buffer buff
+       (slime-fuzzy-disable-target-buffer-completions-mode)
+       (push last-input-event unread-command-events)))))
+
+(defun slime-fuzzy-select/mouse (event)
+  "Handle a mouse-2 click on a completion choice as if point were
+on the completion choice and the slime-fuzzy-select command was
+run."
+  (interactive "e")
+  (with-current-buffer (window-buffer (posn-window (event-end event)))
+    (save-excursion
+      (goto-char (posn-point (event-end event)))
+      (when (get-text-property (point) 'mouse-face)
+        (slime-fuzzy-insert-from-point)
+        (slime-fuzzy-select)))))
+
+(defun slime-fuzzy-done ()
+  "Cleans up after the completion process.  This removes all hooks,
+and attempts to restore the window configuration.  If this fails,
+it just burys the completions buffer and leaves the window
+configuration alone."
+  (when slime-fuzzy-target-buffer
+    (set-buffer slime-fuzzy-target-buffer)
+    (slime-fuzzy-disable-target-buffer-completions-mode)
+    (if (slime-fuzzy-maybe-restore-window-configuration)
+        (bury-buffer (slime-get-fuzzy-buffer))
+        ;; We couldn't restore the windows, so just bury the fuzzy
+        ;; completions buffer and let something else fill it in.
+        (pop-to-buffer (slime-get-fuzzy-buffer))
+        (bury-buffer))
+    (pop-to-buffer slime-fuzzy-target-buffer)
+    (goto-char slime-fuzzy-end)
+    (setq slime-fuzzy-target-buffer nil)
+    (remove-hook 'window-configuration-change-hook
+		 'slime-fuzzy-window-configuration-change)))
+
+(defun slime-fuzzy-maybe-restore-window-configuration ()
+  "Restores the saved window configuration if it has not been
+nullified."
+  (when (boundp 'window-configuration-change-hook)
+    (remove-hook 'window-configuration-change-hook
+                 'slime-fuzzy-window-configuration-change))
+  (if (not slime-fuzzy-saved-window-configuration)
+      nil
+    (set-window-configuration slime-fuzzy-saved-window-configuration)
+    (setq slime-fuzzy-saved-window-configuration nil)
+    t))
+
+(defun slime-fuzzy-window-configuration-change ()
+  "Called on window-configuration-change-hook.  Since the window
+configuration was changed, we nullify our saved configuration."
+  (setq slime-fuzzy-saved-window-configuration nil))
+
+;;; Initialization 
+
+(defun slime-fuzzy-init ()
+  (add-hook 'slime-connected-hook 'slime-fuzzy-on-connect)
+  (slime-fuzzy-bind-keys))
+
+(defun slime-fuzzy-bind-keys ()
+  (define-key slime-mode-map "\C-c\M-i" 'slime-fuzzy-complete-symbol)
+  (define-key slime-repl-mode-map "\C-c\M-i" 'slime-fuzzy-complete-symbol))
+
+(defun slime-fuzzy-on-connect ()
+  (slime-eval-async '(swank:swank-require :swank-fuzzy)))
+
+(provide 'slime-fuzzy)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-highlight-edits.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,99 @@
+;;; slime-higlight-edits --- highlight edited, i.e. not yet compiled, code 
+;;
+;; Author: William Bland <doctorbill.news at gmail.com> and others
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation: 
+;; 
+;; Add something like this your .emacs: 
+;;
+;;   (add-to-list 'load-path "<contrib-dir>")
+;;   (autoload 'slime-highlight-edits-mode "slime-highlight-edits")
+;;   (add-hook 'slime-mode-hook (lambda () (slime-highlight-edits-mode 1)))
+
+(defface slime-highlight-edits-face
+    `((((class color) (background light))
+       (:background "lightgray"))
+      (((class color) (background dark))
+       (:background "dimgray"))
+      (t (:background "yellow")))
+  "Face for displaying edit but not compiled code."
+  :group 'slime-mode-faces)
+
+(define-minor-mode slime-highlight-edits-mode 
+  "Minor mode to highlight not-yet-compiled code." nil)
+
+(add-hook 'slime-highlight-edits-mode-on-hook
+          'slime-highlight-edits-init-buffer)
+
+(add-hook 'slime-highlight-edits-mode-off-hook
+          'slime-highlight-edits-reset-buffer)
+
+(defun slime-highlight-edits-init-buffer ()
+  (make-local-variable 'after-change-functions)
+  (add-to-list 'after-change-functions 
+               'slime-highlight-edits)
+  (add-to-list 'slime-before-compile-functions
+               'slime-highlight-edits-compile-hook))
+
+(defun slime-highlight-edits-reset-buffer ()
+  (setq after-change-functions  
+        (remove 'slime-highlight-edits after-change-functions))
+  (slime-remove-edits (point-min) (point-max)))
+
+;; FIXME: what's the LEN arg for?
+(defun slime-highlight-edits (beg end &optional len) 
+  (save-match-data
+    (when (and (slime-connected-p)
+               (not (slime-inside-comment-p beg end))
+               (not (slime-only-whitespace-p beg end)))
+      (let ((overlay (make-overlay beg end)))
+        (overlay-put overlay 'face 'slime-highlight-edits-face)
+        (overlay-put overlay 'slime-edit t)))))
+
+(defun slime-remove-edits (start end)
+  "Delete the existing Slime edit hilights in the current buffer."
+  (save-excursion
+    (goto-char start)
+    (while (< (point) end)
+      (dolist (o (overlays-at (point)))
+        (when (overlay-get o 'slime-edit)
+          (delete-overlay o)))
+      (goto-char (next-overlay-change (point))))))
+
+(defun slime-highlight-edits-compile-hook (start end)
+  (when slime-highlight-edits-mode
+    (let ((start (save-excursion (goto-char start) 
+				 (skip-chars-backward " \t\n\r")
+				 (point)))
+	  (end (save-excursion (goto-char end) 
+			       (skip-chars-forward " \t\n\r")
+			       (point))))
+      (slime-remove-edits start end))))
+
+(defun slime-inside-comment-p (beg end)
+  "Is the region from BEG to END in a comment?"
+  (save-excursion
+    (goto-char beg)
+    (let* ((hs-c-start-regexp ";\\|#|")
+           (comment (hs-inside-comment-p)))
+      (and comment
+           (destructuring-bind (cbeg cend) comment
+             (<= end cend))))))
+
+(defun slime-only-whitespace-p (beg end)
+  "Contains the region from BEG to END only whitespace?"
+  (save-excursion
+    (goto-char beg)
+    (skip-chars-forward " \n\t\r" end)
+    (<= end (point))))
+
+(defun slime-highlight-edits-mode-on () (slime-highlight-edits-mode 1))
+
+(defun slime-highlight-edits-init ()
+  (add-hook 'slime-mode-hook 'slime-highlight-edits-mode-on))
+
+(defun slime-highlight-edits-unload ()
+  (remove-hook 'slime-mode-hook 'slime-highlight-edits-mode-on))
+
+(provide 'slime-highlight-edits)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,378 @@
+;;; slime-parse.el --- parsing of Common Lisp source code
+;;
+;; Authors: Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          and others
+;; 
+;; License: GNU GPL (same license as Emacs)
+;;
+
+(defun slime-incomplete-form-at-point ()
+  "Looks for a ``raw form spec'' around point to be processed by
+SWANK::PARSE-FORM-SPEC. It is similiar to
+SLIME-INCOMPLETE-SEXP-AT-POINT but looks further back than just
+one sexp to find out the context."
+  (multiple-value-bind (operators arg-indices points)
+      (slime-enclosing-form-specs)
+    (if (null operators)
+        ""
+        (let ((op (first operators)))
+          (destructure-case (slime-ensure-list op)
+            ((:declaration declspec) op)
+            ((:type-specifier typespec) op)
+            (t (slime-ensure-list
+                (save-excursion (goto-char (first points))
+                                (slime-parse-sexp-at-point 
+				 (1+ (first arg-indices)))))))))))
+
+;; XXX: unused function
+(defun slime-cl-symbol-external-ref-p (symbol)
+  "Does SYMBOL refer to an external symbol?
+FOO:BAR is an external reference.
+FOO::BAR is not, and nor is BAR."
+  (let ((name (if (stringp symbol) symbol (symbol-name symbol))))
+    (and (string-match ":" name)
+         (not (string-match "::" name)))))
+
+(defun slime-cl-symbol-name (symbol)
+  (let ((n (if (stringp symbol) symbol (symbol-name symbol))))
+    (if (string-match ":\\([^:]*\\)$" n)
+	(let ((symbol-part (match-string 1 n)))
+          (if (string-match "^|\\(.*\\)|$" symbol-part)
+              (match-string 1 symbol-part)
+              symbol-part))
+      n)))
+
+(defun slime-cl-symbol-package (symbol &optional default)
+  (let ((n (if (stringp symbol) symbol (symbol-name symbol))))
+    (if (string-match "^\\([^:]*\\):" n)
+	(match-string 1 n)
+      default)))
+
+;; XXX: unused function
+(defun slime-qualify-cl-symbol (symbol-or-name)
+  "Like `slime-qualify-cl-symbol-name', but interns the result."
+  (intern (slime-qualify-cl-symbol-name symbol-or-name)))
+
+(defun slime-qualify-cl-symbol-name (symbol-or-name)
+  "Return a package-qualified symbol-name that indicates the CL symbol
+SYMBOL. If SYMBOL doesn't already have a package prefix the current
+package is used."
+  (let ((s (if (stringp symbol-or-name)
+               symbol-or-name
+             (symbol-name symbol-or-name))))
+    (if (slime-cl-symbol-package s)
+        s
+      (format "%s::%s"
+              (let* ((package (slime-current-package)))
+                ;; package is a string like ":cl-user" or "CL-USER".
+                (if (and package (string-match "^:" package))
+                    (substring package 1)
+                  package))
+              (slime-cl-symbol-name s)))))
+
+
+(defun slime-parse-sexp-at-point (&optional n skip-blanks-p)
+  "Return the sexp at point as a string, otherwise nil.
+If N is given and greater than 1, a list of all such sexps
+following the sexp at point is returned. (If there are not
+as many sexps as N, a list with < N sexps is returned.)
+
+If SKIP-BLANKS-P is true, leading whitespaces &c are skipped.
+"
+  (interactive "p") (or n (setq n 1))
+  (flet ((sexp-at-point (first-choice)
+           (let ((string (if (eq first-choice :symbol-first)
+                             (or (slime-symbol-name-at-point)
+                                 (thing-at-point 'sexp))
+                             (or (thing-at-point 'sexp)
+                                 (slime-symbol-name-at-point)))))
+             (if string (substring-no-properties string) nil))))
+    ;; `thing-at-point' depends upon the current syntax table; otherwise
+    ;; keywords like `:foo' are not recognized as sexps. (This function
+    ;; may be called from temporary buffers etc.)
+    (with-syntax-table lisp-mode-syntax-table
+      (save-excursion
+        (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
+          (slime-forward-blanks))
+        (let ((result nil))
+          (dotimes (i n)
+            ;; `foo(bar baz)' where point is at ?\( or ?\).
+            (if (and (char-after) (member (char-syntax (char-after)) '(?\( ?\) ?\')))
+                (push (sexp-at-point :sexp-first) result)
+                (push (sexp-at-point :symbol-first) result))
+            (ignore-errors (forward-sexp) (slime-forward-blanks))
+            (save-excursion
+              (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
+                (return))))
+          (if (slime-length= result 1)
+              (first result)
+              (nreverse result)))))))
+
+(defun slime-incomplete-sexp-at-point (&optional n)
+  (interactive "p") (or n (setq n 1))
+  (buffer-substring-no-properties (save-excursion (backward-up-list n) (point))
+                                  (point)))
+
+
+(defun slime-parse-extended-operator-name (user-point forms indices points)
+  "Assume that point is directly at the operator that should be parsed.
+USER-POINT is the value of `point' where the user was looking at.
+OPS, INDICES and POINTS are updated to reflect the new values after
+parsing, and are then returned back as multiple values."
+  ;; OPS, INDICES and POINTS are like the finally returned values of
+  ;; SLIME-ENCLOSING-FORM-SPECS except that they're in reversed order,
+  ;; i.e. the leftmost (that is the latest) operator comes
+  ;; first.
+  (save-excursion
+    (ignore-errors
+      (let* ((current-op (first (first forms)))
+             (op-name (upcase (slime-cl-symbol-name current-op)))
+             (assoc (assoc op-name slime-extended-operator-name-parser-alist))
+             (entry (cdr assoc))
+             (parser (if (and entry (listp entry)) 
+                         (apply (first entry) (rest entry))
+                         entry)))
+        (ignore-errors
+          (forward-char (1+ (length current-op)))
+          (slime-forward-blanks))
+        (when parser
+          (multiple-value-setq (forms indices points)
+            (funcall parser op-name user-point forms indices points))))))
+  (values forms indices points))
+
+
+(defvar slime-extended-operator-name-parser-alist
+  '(("MAKE-INSTANCE"  . (slime-make-extended-operator-parser/look-ahead 1))
+    ("MAKE-CONDITION" . (slime-make-extended-operator-parser/look-ahead 1))
+    ("ERROR"          . (slime-make-extended-operator-parser/look-ahead 1))
+    ("SIGNAL"         . (slime-make-extended-operator-parser/look-ahead 1))
+    ("WARN"           . (slime-make-extended-operator-parser/look-ahead 1))
+    ("CERROR"         . (slime-make-extended-operator-parser/look-ahead 2))
+    ("CHANGE-CLASS"   . (slime-make-extended-operator-parser/look-ahead 2))
+    ("DEFMETHOD"      . (slime-make-extended-operator-parser/look-ahead 1))
+    ("APPLY"          . (slime-make-extended-operator-parser/look-ahead 1))
+    ("DECLARE"        . slime-parse-extended-operator/declare)
+    ("DECLAIM"        . slime-parse-extended-operator/declare)
+    ("PROCLAIM"       . slime-parse-extended-operator/declare)))
+
+(defun slime-make-extended-operator-parser/look-ahead (steps)
+  "Returns a parser that parses the current operator at point
+plus STEPS-many additional sexps on the right side of the
+operator."
+  (lexical-let ((n steps))
+    #'(lambda (name user-point current-forms current-indices current-points)
+        (let ((old-forms (rest current-forms)))
+          (let* ((args (slime-ensure-list (slime-parse-sexp-at-point n)))
+                 (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
+            (setq current-forms (cons `(,name , at arg-specs) old-forms))))
+        (values current-forms current-indices current-points)
+        )))
+
+(defun slime-parse-extended-operator/declare
+    (name user-point current-forms current-indices current-points)
+  (when (string= (thing-at-point 'char) "(")
+    (let ((orig-point (point)))
+      (goto-char user-point)
+      (slime-end-of-symbol)
+      ;; Head of CURRENT-FORMS is "declare" at this point, but we're
+      ;; interested in what comes next.
+      (let* ((decl-ops     (rest current-forms))
+             (decl-indices (rest current-indices))
+             (decl-points  (rest current-points))
+             (decl-pos     (1- (first decl-points)))
+             (nesting      (slime-nesting-until-point decl-pos))
+             (declspec-str (concat (slime-incomplete-sexp-at-point nesting)
+                                   (make-string nesting ?\)))))
+        (save-match-data ; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
+          (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
+                                       declspec-str))
+                  (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$"
+                                       declspec-str)))
+              (let* ((typespec-str (match-string 1 declspec-str))
+                     (typespec (slime-make-form-spec-from-string typespec-str)))
+                (setq current-forms   (list `(:type-specifier ,typespec)))
+                (setq current-indices (list (second decl-indices)))
+                (setq current-points  (list (second decl-points))))
+              (let ((declspec (slime-make-form-spec-from-string declspec-str)))
+                (setq current-forms   (list `(,name) `(:declaration ,declspec)))
+                (setq current-indices (list (first current-indices)
+					    (first decl-indices)))
+                (setq current-points  (list (first current-points)
+					    (first decl-points)))))))))
+  (values current-forms current-indices current-points))
+
+(defun slime-nesting-until-point (target-point)
+  "Returns the nesting level between current point and TARGET-POINT.
+If TARGET-POINT could not be reached, 0 is returned. (As a result
+TARGET-POINT should always be placed just before a `?\('.)"
+  (save-excursion
+    (let ((nesting 0))
+      (while (> (point) target-point)
+        (backward-up-list)
+        (incf nesting))
+      (if (= (point) target-point)
+          nesting
+          0))))
+
+(defun slime-make-form-spec-from-string (string &optional strip-operator-p)
+  "If STRIP-OPERATOR-P is T and STRING is the string
+representation of a form, the string representation of this form
+is stripped from the form. This can be important to avoid mutual
+recursion between this function, `slime-enclosing-form-specs' and
+`slime-parse-extended-operator-name'.
+
+Examples:
+
+  \"(foo (bar 1 (baz :quux)) 'toto)\" 
+
+      => (\"foo\" (\"bar\" \"1\" (\"baz\" \":quux\")) \"'toto\")
+"
+  (cond ((slime-length= string 0) "")
+	((equal string "()") '())
+	(t
+	 (with-temp-buffer
+	   ;; Do NEVER ever try to activate `lisp-mode' here with
+	   ;; `slime-use-autodoc-mode' enabled, as this function is used
+	   ;; to compute the current autodoc itself.
+	   (erase-buffer)
+	   (insert string)
+	   (when strip-operator-p ; `(OP arg1 arg2 ...)' ==> `(arg1 arg2 ...)'
+	     (goto-char (point-min))
+	     (when (string= (thing-at-point 'char) "(")
+	       (ignore-errors (forward-char 1)
+			      (forward-sexp)
+			      (slime-forward-blanks))
+	       (delete-region (point-min) (point))
+	       (insert "(")))
+	   (goto-char (1- (point-max))) ; `(OP arg1 ... argN|)'
+	   (multiple-value-bind (forms indices points)
+	       (slime-enclosing-form-specs 1)
+	     (if (null forms)
+		 string
+                (let ((n (first (last indices))))
+		   (goto-char (1+ (point-min))) ; `(|OP arg1 ... argN)'
+		   (mapcar #'(lambda (s)
+			       (assert (not (equal s string)))       ; trap against
+			       (slime-make-form-spec-from-string s)) ;  endless recursion.
+			   (slime-ensure-list
+			    (slime-parse-sexp-at-point (1+ n) t))))))))))
+
+
+(defun slime-enclosing-form-specs (&optional max-levels)
+  "Return the list of ``raw form specs'' of all the forms 
+containing point from right to left.
+
+As a secondary value, return a list of indices: Each index tells
+for each corresponding form spec in what argument position the
+user's point is.
+
+As tertiary value, return the positions of the operators that are
+contained in the returned form specs. 
+
+When MAX-LEVELS is non-nil, go up at most this many levels of
+parens.
+
+\(See SWANK::PARSE-FORM-SPEC for more information about what
+exactly constitutes a ``raw form specs'')
+
+Examples:
+
+  A return value like the following
+
+    (values  ((\"quux\") (\"bar\") (\"foo\")) (3 2 1) (p1 p2 p3))
+
+  can be interpreted as follows:
+
+    The user point is located in the 3rd argument position of a
+    form with the operator name \"quux\" (which starts at P1.)
+   
+    This form is located in the 2nd argument position of a form
+    with the operator name \"bar\" (which starts at P2.)
+
+    This form again is in the 1st argument position of a form
+    with the operator name \"foo\" (which itself begins at P3.)
+
+  For instance, the corresponding buffer content could have looked
+  like `(foo (bar arg1 (quux 1 2 |' where `|' denotes point.
+"
+  (let ((level 1)
+        (parse-sexp-lookup-properties nil)
+        (initial-point (point))
+        (result '()) (arg-indices '()) (points '())) 
+    ;; The expensive lookup of syntax-class text properties is only
+    ;; used for interactive balancing of #<...> in presentations; we
+    ;; do not need them in navigating through the nested lists.
+    ;; This speeds up this function significantly.
+    (ignore-errors
+      (save-excursion
+        ;; Make sure we get the whole thing at point.
+        (if (not (slime-inside-string-p))
+	    (slime-end-of-symbol)
+	  (slime-beginning-of-string)
+	  (forward-sexp))
+        (save-restriction
+          ;; Don't parse more than 20000 characters before point, so we don't spend
+          ;; too much time.
+          (narrow-to-region (max (point-min) (- (point) 20000)) (point-max))
+          (narrow-to-region (save-excursion (beginning-of-defun) (point))
+                            (min (1+ (point)) (point-max)))
+          (while (or (not max-levels)
+                     (<= level max-levels))
+            (let ((arg-index 0))
+              ;; Move to the beginning of the current sexp if not already there.
+              (if (or (and (char-after)
+                           (member (char-syntax (char-after)) '(?\( ?')))
+                      (member (char-syntax (char-before)) '(?\  ?>)))
+                  (incf arg-index))
+              (ignore-errors (backward-sexp 1))
+              (while (and (< arg-index 64)
+                          (ignore-errors (backward-sexp 1) 
+                                         (> (point) (point-min))))
+                (incf arg-index))
+              (backward-up-list 1)
+              (when (member (char-syntax (char-after)) '(?\( ?')) 
+                (incf level)
+                (forward-char 1)
+                (let ((name (slime-symbol-name-at-point)))
+                  (cond
+                    (name
+                     (save-restriction
+                       (widen) ; to allow looking-ahead/back in extended parsing.
+                       (multiple-value-bind (new-result new-indices new-points)
+                           (slime-parse-extended-operator-name initial-point
+                                                               (cons `(,name) result) ; minimal form spec
+                                                               (cons arg-index arg-indices)
+                                                               (cons (point) points))
+                         (setq result new-result)
+                         (setq arg-indices new-indices)
+                         (setq points new-points))))
+                    (t
+                     (push nil result)
+                     (push arg-index arg-indices)
+                     (push (point) points))))
+                (backward-up-list 1)))))))
+    (values 
+     (nreverse result)
+     (nreverse arg-indices)
+     (nreverse points))))
+
+
+(defun slime-ensure-list (thing)
+  (if (listp thing) thing (list thing)))
+
+(defun slime-inside-string-p ()
+  (let* ((toplevel-begin (save-excursion (beginning-of-defun) (point)))
+	 (parse-result (parse-partial-sexp toplevel-begin (point)))
+	 (inside-string-p  (nth 3 parse-result))
+	 (string-start-pos (nth 8 parse-result)))
+    (and inside-string-p string-start-pos)))
+
+(defun slime-beginning-of-string ()
+  (let ((string-start-pos (slime-inside-string-p)))
+    (if string-start-pos
+	(goto-char string-start-pos)
+	(error "We're not within a string"))))
+
+(provide 'slime-parse)
+

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-presentation-streams.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,29 @@
+;;; swank-presentation-streams.el --- Streams that allow attaching object identities
+;;;                                   to portions of output
+;;;
+;;; Authors: Alan Ruttenberg  <alanr-l at mumble.net>
+;;;          Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;;          Helmut Eller  <heller at common-lisp.net>
+;;;
+;;; License: GNU GPL (same license as Emacs)
+;;;
+;;; Installation
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-presentation-streams)))
+;;
+
+
+;;; Initialization
+
+(require 'slime-presentations)
+
+(add-hook 'slime-connected-hook 'slime-install-presentation-streams)
+
+(defun slime-install-presentation-streams ()
+  (slime-eval-async '(swank:swank-require :swank-presentation-streams)))
+
+(provide 'slime-presentation-streams)
+

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,649 @@
+;;; swank-presentations.el --- imitat LispM' presentations
+;;;
+;;; Authors: Alan Ruttenberg  <alanr-l at mumble.net>
+;;;          Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;;
+;;; License: GNU GPL (same license as Emacs)
+;;;
+;;; Installation
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-presentations)))
+;;
+
+(defface slime-repl-output-mouseover-face
+  (if (featurep 'xemacs)
+      '((t (:bold t)))
+    (if (slime-face-inheritance-possible-p)
+        '((t
+           (:box
+            (:line-width 1 :color "black" :style released-button)
+            :inherit
+            slime-repl-inputed-output-face)))
+      '((t (:box (:line-width 1 :color "black"))))))
+  "Face for Lisp output in the SLIME REPL, when the mouse hovers over it"
+  :group 'slime-repl)
+
+(defface slime-repl-inputed-output-face
+  '((((class color) (background light)) (:foreground "Red"))
+    (((class color) (background dark)) (:foreground "Red"))
+    (t (:slant italic)))
+  "Face for the result of an evaluation in the SLIME REPL."
+  :group 'slime-repl)
+
+;; FIXME: This conditional is not right - just used because the code
+;; here does not work in XEmacs.
+(when (boundp 'text-property-default-nonsticky)
+  (pushnew '(slime-repl-presentation . t) text-property-default-nonsticky
+	   :test 'equal)
+  (pushnew '(slime-repl-result-face . t) text-property-default-nonsticky
+	   :test 'equal))
+
+(make-variable-buffer-local
+ (defvar slime-presentation-start-to-point (make-hash-table)))
+
+(defun slime-mark-presentation-start (id &optional target)
+  "Mark the beginning of a presentation with the given ID.
+TARGET can be nil (regular process output) or :repl-result."
+  (setf (gethash id slime-presentation-start-to-point) 
+        ;; We use markers because text can also be inserted before this presentation.
+        ;; (Output arrives while we are writing presentations within REPL results.)
+        (copy-marker (slime-output-target-marker target) nil)))
+
+(defun slime-mark-presentation-start-handler (process string)
+  (if (and string (string-match "<\\([-0-9]+\\)" string))
+      (let* ((match (substring string (match-beginning 1) (match-end 1)))
+             (id (car (read-from-string match))))
+        (slime-mark-presentation-start id))))
+
+(defun slime-mark-presentation-end (id &optional target)
+  "Mark the end of a presentation with the given ID.
+TARGET can be nil (regular process output) or :repl-result."
+  (let ((start (gethash id slime-presentation-start-to-point)))
+    (remhash id slime-presentation-start-to-point)
+    (when start
+      (let* ((marker (slime-output-target-marker target))
+             (buffer (and marker (marker-buffer marker))))
+        (with-current-buffer buffer
+          (let ((end (marker-position marker)))
+            (slime-add-presentation-properties start end
+                                               id nil)))))))
+
+(defun slime-mark-presentation-end-handler (process string)
+  (if (and string (string-match ">\\([-0-9]+\\)" string))
+      (let* ((match (substring string (match-beginning 1) (match-end 1)))
+             (id (car (read-from-string match))))
+        (slime-mark-presentation-end id))))
+
+(defstruct slime-presentation text id)
+
+(defvar slime-presentation-syntax-table
+  (let ((table (copy-syntax-table lisp-mode-syntax-table)))
+    ;; We give < and > parenthesis syntax, so that #< ... > is treated
+    ;; as a balanced expression.  This allows to use C-M-k, C-M-SPC,
+    ;; etc. to deal with a whole presentation.  (For Lisp mode, this
+    ;; is not desirable, since we do not wish to get a mismatched
+    ;; paren highlighted everytime we type < or >.)
+    (modify-syntax-entry ?< "(>" table)
+    (modify-syntax-entry ?> ")<" table)
+    table)
+  "Syntax table for presentations.")
+
+(defun slime-add-presentation-properties (start end id result-p)
+  "Make the text between START and END a presentation with ID.
+RESULT-P decides whether a face for a return value or output text is used."
+  (let* ((text (buffer-substring-no-properties start end))
+         (presentation (make-slime-presentation :text text :id id)))
+    (let ((inhibit-modification-hooks t))
+      (add-text-properties start end
+                           `(modification-hooks (slime-after-change-function)
+                             insert-in-front-hooks (slime-after-change-function)
+                             insert-behind-hooks (slime-after-change-function)
+                             syntax-table ,slime-presentation-syntax-table
+                             rear-nonsticky t))
+      ;; Use the presentation as the key of a text property
+      (case (- end start)
+        (0)
+        (1
+         (add-text-properties start end
+                              `(slime-repl-presentation ,presentation
+                                ,presentation :start-and-end)))
+        (t
+         (add-text-properties start (1+ start) 
+                              `(slime-repl-presentation ,presentation
+                                ,presentation :start))
+         (when (> (- end start) 2)
+           (add-text-properties (1+ start) (1- end)
+                                `(,presentation :interior)))
+         (add-text-properties (1- end) end
+                              `(slime-repl-presentation ,presentation
+                                ,presentation :end))))
+      ;; Also put an overlay for the face and the mouse-face.  This enables
+      ;; highlighting of nested presentations.  However, overlays get lost
+      ;; when we copy a presentation; their removal is also not undoable.
+      ;; In these cases the mouse-face text properties need to take over ---
+      ;; but they do not give nested highlighting.
+      (slime-ensure-presentation-overlay start end presentation))))
+
+(defun slime-ensure-presentation-overlay (start end presentation)
+  (unless (find presentation (overlays-at start)
+                :key (lambda (overlay) 
+                       (overlay-get overlay 'slime-repl-presentation)))
+    (let ((overlay (make-overlay start end (current-buffer) t nil)))
+      (overlay-put overlay 'slime-repl-presentation presentation)
+      (overlay-put overlay 'mouse-face 'slime-repl-output-mouseover-face)
+      (overlay-put overlay 'help-echo 
+                   (if (eq major-mode 'slime-repl-mode)
+                       "mouse-2: copy to input; mouse-3: menu"
+                     "mouse-2: inspect; mouse-3: menu"))
+      (overlay-put overlay 'face 'slime-repl-inputed-output-face)
+      (overlay-put overlay 'keymap slime-presentation-map))))
+  
+(defun slime-remove-presentation-properties (from to presentation)
+  (let ((inhibit-read-only t)) 
+    (remove-text-properties from to
+                            `(,presentation t syntax-table t rear-nonsticky t))
+    (when (eq (get-text-property from 'slime-repl-presentation) presentation)
+      (remove-text-properties from (1+ from) `(slime-repl-presentation t)))
+    (when (eq (get-text-property (1- to) 'slime-repl-presentation) presentation)
+      (remove-text-properties (1- to) to `(slime-repl-presentation t)))
+    (dolist (overlay (overlays-at from))
+      (when (eq (overlay-get overlay 'slime-repl-presentation) presentation)
+        (delete-overlay overlay)))))
+
+(defun slime-insert-presentation (string output-id &optional rectangle)
+  "Insert STRING in current buffer and mark it as a presentation 
+corresponding to OUTPUT-ID.  If RECTANGLE is true, indent multi-line
+strings to line up below the current point."
+  (flet ((insert-it ()
+                    (if rectangle 
+                        (slime-insert-indented string)
+                      (insert string))))
+    (let ((start (point)))
+      (insert-it)
+      (slime-add-presentation-properties start (point) output-id t))))
+
+(defun slime-presentation-whole-p (presentation start end &optional object)
+  (let ((object (or object (current-buffer))))
+    (string= (etypecase object
+               (buffer (with-current-buffer object
+                         (buffer-substring-no-properties start end)))
+               (string (substring-no-properties object start end)))
+             (slime-presentation-text presentation))))
+
+(defun slime-presentations-around-point (point &optional object)
+  (let ((object (or object (current-buffer))))
+    (loop for (key value . rest) on (text-properties-at point object) by 'cddr
+          when (slime-presentation-p key)
+          collect key)))
+
+(defun slime-presentation-start-p (tag)
+  (memq tag '(:start :start-and-end)))
+
+(defun slime-presentation-stop-p (tag)
+  (memq tag '(:end :start-and-end)))
+
+(defun* slime-presentation-start (point presentation
+                                        &optional (object (current-buffer)))
+  "Find start of `presentation' at `point' in `object'.
+Return buffer index and whether a start-tag was found."
+  (let* ((this-presentation (get-text-property point presentation object)))
+    (while (not (slime-presentation-start-p this-presentation))
+      (let ((change-point (previous-single-property-change 
+                           point presentation object)))
+        (unless change-point
+          (return-from slime-presentation-start
+            (values (etypecase object
+                      (buffer (with-current-buffer object 1))
+                      (string 0))
+                    nil)))
+        (setq this-presentation (get-text-property change-point 
+                                                   presentation object))
+        (unless this-presentation
+          (return-from slime-presentation-start 
+            (values point nil)))
+        (setq point change-point)))
+    (values point t)))
+
+(defun* slime-presentation-end (point presentation
+                                      &optional (object (current-buffer)))
+  "Find end of presentation at `point' in `object'.  Return buffer
+index (after last character of the presentation) and whether an
+end-tag was found."
+  (let* ((this-presentation (get-text-property point presentation object)))
+    (while (not (slime-presentation-stop-p this-presentation))
+      (let ((change-point (next-single-property-change 
+                           point presentation object)))
+        (unless change-point
+          (return-from slime-presentation-end
+            (values (etypecase object
+                      (buffer (with-current-buffer object (point-max)))
+                      (string (length object))) 
+                    nil)))
+        (setq point change-point)
+        (setq this-presentation (get-text-property point 
+                                                   presentation object))))
+    (if this-presentation 
+        (let ((after-end (next-single-property-change point
+                                                      presentation object)))
+          (if (not after-end)
+              (values (etypecase object
+                        (buffer (with-current-buffer object (point-max)))
+                        (string (length object))) 
+                      t)
+              (values after-end t)))
+        (values point nil))))
+
+(defun* slime-presentation-bounds (point presentation 
+                                         &optional (object (current-buffer)))
+  "Return start index and end index of `presentation' around `point'
+in `object', and whether the presentation is complete."
+  (multiple-value-bind (start good-start)
+      (slime-presentation-start point presentation object)
+    (multiple-value-bind (end good-end)
+        (slime-presentation-end point presentation object)
+      (values start end 
+              (and good-start good-end
+                   (slime-presentation-whole-p presentation 
+                                               start end object))))))
+
+(defun slime-presentation-around-point (point &optional object)
+  "Return presentation, start index, end index, and whether the
+presentation is complete."
+  (let ((object (or object (current-buffer)))
+        (innermost-presentation nil)
+        (innermost-start 0)
+        (innermost-end most-positive-fixnum))
+    (dolist (presentation (slime-presentations-around-point point object))
+      (multiple-value-bind (start end whole-p)
+          (slime-presentation-bounds point presentation object)
+        (when whole-p 
+          (when (< (- end start) (- innermost-end innermost-start))
+            (setq innermost-start start
+                  innermost-end end
+                  innermost-presentation presentation)))))
+    (values innermost-presentation
+            innermost-start innermost-end)))
+
+(defun slime-presentation-around-or-before-point (point &optional object)
+  (let ((object (or object (current-buffer))))
+    (multiple-value-bind (presentation start end whole-p)
+        (slime-presentation-around-point point object)
+      (if presentation
+          (values presentation start end whole-p)
+        (slime-presentation-around-point (1- point) object)))))
+
+(defun* slime-for-each-presentation-in-region (from to function &optional (object (current-buffer)))
+  "Call `function' with arguments `presentation', `start', `end',
+`whole-p' for every presentation in the region `from'--`to' in the
+string or buffer `object'."
+  (flet ((handle-presentation (presentation point)
+                              (multiple-value-bind (start end whole-p)
+                                  (slime-presentation-bounds point presentation object)
+                                (funcall function presentation start end whole-p))))
+    ;; Handle presentations active at `from'.
+    (dolist (presentation (slime-presentations-around-point from object))
+      (handle-presentation presentation from))
+    ;; Use the `slime-repl-presentation' property to search for new presentations.
+    (let ((point from))
+      (while (< point to)
+        (setq point (next-single-property-change point 'slime-repl-presentation object to))
+        (let* ((presentation (get-text-property point 'slime-repl-presentation object))
+               (status (get-text-property point presentation object)))
+          (when (slime-presentation-start-p status)
+            (handle-presentation presentation point)))))))
+
+;; XEmacs compatibility hack, from message by Stephen J. Turnbull on
+;; xemacs-beta at xemacs.org of 18 Mar 2002
+(unless (boundp 'undo-in-progress)
+  (defvar undo-in-progress nil
+   "Placeholder defvar for XEmacs compatibility from SLIME.")
+  (defadvice undo-more (around slime activate)
+     (let ((undo-in-progress t)) ad-do-it)))
+
+(defun slime-after-change-function (start end &rest ignore)
+  "Check all presentations within and adjacent to the change.
+When a presentation has been altered, change it to plain text."
+  (let ((inhibit-modification-hooks t))
+    (let ((real-start (max 1 (1- start)))
+          (real-end   (min (1+ (buffer-size)) (1+ end)))
+          (any-change nil))
+      ;; positions around the change
+      (slime-for-each-presentation-in-region 
+       real-start real-end
+       (lambda (presentation from to whole-p)
+         (cond
+          (whole-p
+           (slime-ensure-presentation-overlay from to presentation))
+          ((not undo-in-progress)
+           (slime-remove-presentation-properties from to 
+                                                 presentation)
+           (setq any-change t)))))
+      (when any-change
+        (undo-boundary)))))
+
+(defun slime-presentation-around-click (event)
+  "Return the presentation around the position of the mouse-click EVENT.
+If there is no presentation, signal an error.
+Also return the start position, end position, and buffer of the presentation."
+  (when (and (featurep 'xemacs) (not (button-press-event-p event)))
+    (error "Command must be bound to a button-press-event"))
+  (let ((point (if (featurep 'xemacs) (event-point event) (posn-point (event-end event))))
+        (window (if (featurep 'xemacs) (event-window event) (caadr event))))
+    (with-current-buffer (window-buffer window)
+      (multiple-value-bind (presentation start end)
+          (slime-presentation-around-point point)
+        (unless presentation
+          (error "No presentation at click"))
+        (values presentation start end (current-buffer))))))
+          
+(defun slime-copy-or-inspect-presentation-at-mouse (event)
+  (interactive "e") ; no "@" -- we don't want to select the clicked-at window
+  (multiple-value-bind (presentation start end buffer)
+      (slime-presentation-around-click event)
+    (if (with-current-buffer buffer
+          (eq major-mode 'slime-repl-mode))
+        (slime-copy-presentation-at-mouse event)
+      (slime-inspect-presentation-at-mouse event))))
+
+(defun slime-inspect-presentation-at-mouse (event)
+  (interactive "e")
+  (multiple-value-bind (presentation start end buffer) 
+      (slime-presentation-around-click event)
+    (let ((reset-p 
+           (with-current-buffer buffer
+             (not (eq major-mode 'slime-inspector-mode)))))
+      (slime-eval-async `(swank:inspect-presentation ',(slime-presentation-id presentation) ,reset-p)
+                        'slime-open-inspector))))
+
+(defun slime-copy-presentation-at-mouse (event)
+  (interactive "e")
+  (multiple-value-bind (presentation start end buffer) 
+      (slime-presentation-around-click event)
+    (let ((presentation-text 
+           (with-current-buffer buffer
+             (buffer-substring start end))))
+      (unless (eql major-mode 'slime-repl-mode)
+        (slime-switch-to-output-buffer))
+      (flet ((do-insertion ()
+                           (when (not (string-match "\\s-"
+                                                    (buffer-substring (1- (point)) (point))))
+                             (insert " "))
+                           (insert presentation-text)
+                           (when (and (not (eolp)) (not (looking-at "\\s-")))
+                             (insert " "))))
+        (if (>= (point) slime-repl-prompt-start-mark)
+            (do-insertion)
+          (save-excursion
+            (goto-char (point-max))
+            (do-insertion)))))))
+
+(defun slime-copy-presentation-at-mouse-to-point (event)
+  (interactive "e")
+  (multiple-value-bind (presentation start end buffer) 
+      (slime-presentation-around-click event)
+    (let ((presentation-text 
+           (with-current-buffer buffer
+             (buffer-substring start end))))
+      (when (not (string-match "\\s-"
+                               (buffer-substring (1- (point)) (point))))
+        (insert " "))
+      (insert presentation-text)
+      (slime-after-change-function (point) (point))
+      (when (and (not (eolp)) (not (looking-at "\\s-")))
+        (insert " ")))))
+
+(defun slime-copy-presentation-at-mouse-to-kill-ring (event)
+  (interactive "e")
+  (multiple-value-bind (presentation start end buffer) 
+      (slime-presentation-around-click event)
+    (let ((presentation-text 
+           (with-current-buffer buffer
+             (buffer-substring start end))))
+      (kill-new presentation-text))))
+  
+(defun slime-describe-presentation-at-mouse (event)
+  (interactive "@e")
+  (multiple-value-bind (presentation) (slime-presentation-around-click event)
+    (slime-eval-describe 
+     `(swank::describe-to-string
+       (swank::lookup-presented-object ',(slime-presentation-id presentation))))))
+
+(defun slime-pretty-print-presentation-at-mouse (event)
+  (interactive "@e")
+  (multiple-value-bind (presentation) (slime-presentation-around-click event)
+    (slime-eval-describe 
+     `(swank::swank-pprint
+       (cl:list
+        (swank::lookup-presented-object ',(slime-presentation-id presentation)))))))
+
+(defvar slime-presentation-map (make-sparse-keymap))
+
+(define-key  slime-presentation-map [mouse-2] 'slime-copy-or-inspect-presentation-at-mouse)
+(define-key  slime-presentation-map [mouse-3] 'slime-presentation-menu)
+
+(when (featurep 'xemacs)
+  (define-key  slime-presentation-map [button2] 'slime-copy-or-inspect-presentation-at-mouse)
+  (define-key  slime-presentation-map [button3] 'slime-presentation-menu))
+
+;; protocol for handling up a menu.
+;; 1. Send lisp message asking for menu choices for this object. 
+;;    Get back list of strings.
+;; 2. Let used choose
+;; 3. Call back to execute menu choice, passing nth and string of choice
+
+(defun slime-menu-choices-for-presentation (presentation buffer from to choice-to-lambda)
+  "Return a menu for `presentation' at `from'--`to' in `buffer', suitable for `x-popup-menu'."
+  (let* ((what (slime-presentation-id presentation))
+         (choices (with-current-buffer buffer
+                    (slime-eval 
+                     `(swank::menu-choices-for-presentation-id ',what)))))
+    (flet ((savel (f) ;; IMPORTANT - xemacs can't handle lambdas in x-popup-menu. So give them a name
+            (let ((sym (gensym)))
+              (setf (gethash sym choice-to-lambda) f)
+              sym)))
+    (etypecase choices
+      (list
+       `(,(format "Presentation %s" what)
+         ("" 
+          ("Inspect" . ,(savel 'slime-inspect-presentation-at-mouse))
+          ("Describe" . ,(savel 'slime-describe-presentation-at-mouse))
+          ("Pretty-print" . ,(savel 'slime-pretty-print-presentation-at-mouse))
+          ("Copy to REPL" . ,(savel 'slime-copy-presentation-at-mouse))
+          ("Copy to kill ring" . ,(savel 'slime-copy-presentation-at-mouse-to-kill-ring))
+          ,@(unless buffer-read-only 
+              `(("Copy to point" . ,(savel 'slime-copy-presentation-at-mouse-to-point))))
+          ,@(let ((nchoice 0))
+              (mapcar 
+               (lambda (choice)
+                 (incf nchoice)
+                 (cons choice 
+                       (savel `(lambda ()
+                          (interactive)
+                          (slime-eval 
+                           '(swank::execute-menu-choice-for-presentation-id
+                             ',what ,nchoice ,(nth (1- nchoice) choices)))))))
+               choices)))))
+      (symbol                           ; not-present
+       (with-current-buffer buffer
+         (slime-remove-presentation-properties from to presentation))
+       (sit-for 0)                      ; allow redisplay
+       `("Object no longer recorded" 
+         ("sorry" . ,(if (featurep 'xemacs) nil '(nil)))))))))
+
+(defun slime-presentation-menu (event)
+  (interactive "e")
+  (let* ((point (if (featurep 'xemacs) (event-point event) 
+                  (posn-point (event-end event))))
+         (window (if (featurep 'xemacs) (event-window event) (caadr event)))
+         (buffer (window-buffer window))
+         (choice-to-lambda (make-hash-table)))
+    (multiple-value-bind (presentation from to)
+        (with-current-buffer buffer
+          (slime-presentation-around-point point))
+      (unless presentation
+        (error "No presentation at event position"))
+      (let ((menu (slime-menu-choices-for-presentation 
+                   presentation buffer from to choice-to-lambda)))
+        (let ((choice (x-popup-menu event menu)))
+          (when choice
+            (call-interactively (gethash choice choice-to-lambda))))))))
+
+(defun slime-presentation-expression (presentation)
+  "Return a string that contains a CL s-expression accessing 
+the presented object."
+  (let ((id (slime-presentation-id presentation)))
+    (etypecase id
+      (number         
+       ;; Make sure it works even if *read-base* is not 10.
+       (format "(swank:get-repl-result #10r%d)" id))
+      (list
+       ;; for frame variables and inspector parts
+       (format "(swank:get-repl-result '%s)" id)))))
+
+(defun slime-buffer-substring-with-reified-output (start end)
+  (let ((str-props (buffer-substring start end))
+        (str-no-props (buffer-substring-no-properties start end)))
+    (slime-reify-old-output str-props str-no-props)))
+
+(defun slime-reify-old-output (str-props str-no-props)
+  (let ((pos (slime-property-position 'slime-repl-presentation str-props)))
+    (if (null pos)
+        str-no-props
+        (multiple-value-bind (presentation start-pos end-pos whole-p)
+            (slime-presentation-around-point pos str-props)
+          (if (not presentation)
+              str-no-props
+              (concat (substring str-no-props 0 pos)
+                      ;; Eval in the reader so that we play nice with quote.
+                      ;; -luke (19/May/2005)
+                      "#." (slime-presentation-expression presentation)
+                      (slime-reify-old-output (substring str-props end-pos)
+                                              (substring str-no-props end-pos))))))))
+
+
+
+(defun slime-repl-grab-old-output (replace)
+  "Resend the old REPL output at point.  
+If replace it non-nil the current input is replaced with the old
+output; otherwise the new input is appended."
+  (multiple-value-bind (presentation beg end) 
+      (slime-presentation-around-or-before-point (point))
+    (let ((old-output (buffer-substring beg end))) ;;keep properties
+      ;; Append the old input or replace the current input
+      (cond (replace (goto-char slime-repl-input-start-mark))
+            (t (goto-char slime-repl-input-end-mark)
+               (unless (eq (char-before) ?\ )
+                 (insert " "))))
+      (delete-region (point) slime-repl-input-end-mark)
+      (let ((inhibit-read-only t))
+        (insert old-output)))))
+
+
+;;; hook functions (hard to isolate stuff)
+
+(defun slime-dispatch-presentation-event (event)
+  (destructure-case event
+    ((:presentation-start id &optional target)
+     (slime-mark-presentation-start id target)
+     t)
+    ((:presentation-end id &optional target)
+     (slime-mark-presentation-end id target)
+     t)
+    (t nil)))
+
+(defun slime-presentation-write (string &optional target)
+  (case target
+    ((nil)                              ; Regular process output
+     (with-current-buffer (slime-output-buffer)
+       (slime-with-output-end-mark
+	(slime-propertize-region '(face slime-repl-output-face
+					rear-nonsticky (face))
+	  (insert string))
+        (set-marker slime-output-end (point))
+        (when (and (= (point) slime-repl-prompt-start-mark)
+                   (not (bolp)))
+          (insert "\n")
+          (set-marker slime-output-end (1- (point))))
+        (if (< slime-repl-input-start-mark (point))
+            (set-marker slime-repl-input-start-mark
+                        (point))))))
+    (:repl-result                       
+     (with-current-buffer (slime-output-buffer)
+       (let ((marker (slime-output-target-marker target)))
+         (goto-char marker)
+         (let ((result-start (point)))
+	   (slime-propertize-region `(face slime-repl-result-face
+					   rear-nonsticky (face))
+	     (insert string))
+           ;; Move the input-start marker after the REPL result.
+           (set-marker marker (point))))))
+    (t
+     (let* ((marker (slime-output-target-marker target))
+            (buffer (and marker (marker-buffer marker))))
+       (when buffer
+         (with-current-buffer buffer
+           (save-excursion 
+             ;; Insert STRING at MARKER, then move MARKER behind
+             ;; the insertion.
+             (goto-char marker)
+             (insert-before-markers string)
+             (set-marker marker (point)))))))))
+
+(defun slime-presentation-current-input (&optional until-point-p)
+  "Return the current input as string.
+The input is the region from after the last prompt to the end of
+buffer. Presentations of old results are expanded into code."
+  (slime-buffer-substring-with-reified-output  slime-repl-input-start-mark
+                                               (if (and until-point-p
+                                                        (<= (point) slime-repl-input-end-mark))
+                                                   (point)
+                                                   slime-repl-input-end-mark)))    
+(defun slime-presentation-on-return-pressed ()
+  (cond ((and (car (slime-presentation-around-or-before-point (point)))
+	      (< (point) slime-repl-input-start-mark))
+	 (slime-repl-grab-old-output end-of-input)
+	 (slime-repl-recenter-if-needed)
+	 t)
+	(t nil)))
+
+(defun slime-presentation-on-stream-open (stream)
+  (require 'bridge)
+  (defun bridge-insert (process output)
+    (slime-output-filter process (or output "")))
+  (install-bridge)
+  (setq bridge-destination-insert nil)
+  (setq bridge-source-insert nil)
+  (setq bridge-handlers 
+	(list* '("<" . slime-mark-presentation-start-handler) 
+	       '(">" . slime-mark-presentation-end-handler)
+	       bridge-handlers)))
+
+(defun slime-clear-presentations ()
+  (slime-eval-async `(swank:clear-repl-results)))
+
+;;; Initialization
+
+(defun slime-presentations-init ()
+  (add-hook 'slime-repl-mode-hook
+	    (lambda ()
+	      ;; Respect the syntax text properties of presentation.
+	      (set (make-local-variable 'parse-sexp-lookup-properties) t)
+	      (add-local-hook 'after-change-functions 
+			      'slime-after-change-function)))
+  (add-hook 'slime-event-hooks 'slime-dispatch-presentation-event)
+  (setq slime-write-string-function 'slime-presentation-write)
+  (add-hook 'slime-repl-return-hooks 'slime-presentation-on-return-pressed)
+  (add-hook 'slime-repl-current-input-hooks 'slime-presentation-current-input)
+  (add-hook 'slime-open-stream-hooks 'slime-presentation-on-stream-open)
+  (add-hook 'slime-repl-clear-buffer-hook 'slime-clear-presentations)
+  (add-hook 'slime-connected-hook 'slime-install-presentations))
+
+(defun slime-install-presentations ()
+  (slime-eval-async '(swank:swank-require :swank-presentations)))
+
+(slime-presentations-init)
+
+(provide 'slime-presentations)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-references.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,135 @@
+;;; slime-references.el --- Clickable references to documentation (SBCL only)
+;;
+;; Authors: Christophe Rhodes  <csr21 at cantab.net>
+;;          Luke Gorrie  <luke at bluetail.com>
+;;
+;; License: GNU GPL (same license as Emacs)
+;;
+;;;
+
+(defcustom slime-sbcl-manual-root "http://www.sbcl.org/manual/"
+  "*The base URL of the SBCL manual, for documentation lookup."
+  :type 'string
+  :group 'slime-mode)
+
+(defface sldb-reference-face 
+  (list (list t '(:underline t)))
+  "Face for references."
+  :group 'slime-debugger)
+
+(defun slime-note.references (note)
+  (plist-get note :references))
+
+(defun slime-tree-print-with-references (tree)
+  ;; for SBCL-style references
+  (slime-tree-default-printer tree)
+  (when-let (note (plist-get (slime-tree.plist tree) 'note))
+    (when-let (references (slime-note.references note))
+      (terpri (current-buffer))
+      (princ "See also:" (current-buffer))
+      (terpri (current-buffer))
+      (slime-tree-insert-references references))))
+
+(defun slime-tree-insert-references (references)
+  "Insert documentation references from a condition.
+See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
+  (loop for refs on references
+        for ref = (car refs)
+        do
+        (destructuring-bind (where type what) ref
+          ;; FIXME: this is poorly factored, and shares some code and
+          ;; data with sldb that it shouldn't: notably
+          ;; sldb-reference-face.  Probably the names of
+          ;; sldb-reference-foo should be altered to be not sldb
+          ;; specific.
+          (insert "  " (sldb-format-reference-source where) ", ")
+          (slime-insert-propertized (sldb-reference-properties ref)
+                                    (sldb-format-reference-node what))
+          (insert (format " [%s]" type))
+          (when (cdr refs)
+            (terpri (current-buffer))))))
+
+
+;;;;; SLDB references (rather SBCL specific)
+
+(defun sldb-insert-references (references)
+  "Insert documentation references from a condition.
+See SWANK-BACKEND:CONDITION-REFERENCES for the datatype."
+  (dolist (ref references)
+    (destructuring-bind (where type what) ref
+      (insert "\n" (sldb-format-reference-source where) ", ")
+      (slime-insert-propertized (sldb-reference-properties ref)
+				(sldb-format-reference-node what))
+      (insert (format " [%s]" type)))))
+
+(defun sldb-reference-properties (reference)
+  "Return the properties for a reference.
+Only add clickability to properties we actually know how to lookup."
+  (destructuring-bind (where type what) reference
+    (if (or (and (eq where :sbcl) (eq type :node))
+            (and (eq where :ansi-cl)
+                 (memq type '(:function :special-operator :macro
+			      :section :glossary :issue))))
+        `(sldb-default-action
+          sldb-lookup-reference
+          ;; FIXME: this is a hack!  slime-compiler-notes and sldb are a
+          ;; little too intimately entwined.
+          slime-compiler-notes-default-action sldb-lookup-reference
+          sldb-reference ,reference
+          face sldb-reference-face
+          mouse-face highlight))))
+
+(defun sldb-format-reference-source (where)
+  (case where
+    (:amop    "The Art of the Metaobject Protocol")
+    (:ansi-cl "Common Lisp Hyperspec")
+    (:sbcl    "SBCL Manual")
+    (t        (format "%S" where))))
+
+(defun sldb-format-reference-node (what)
+  (if (listp what)
+      (mapconcat #'prin1-to-string what ".")
+    what))
+
+(defun sldb-lookup-reference ()
+  "Browse the documentation reference at point."
+  (destructuring-bind (where type what)
+      (get-text-property (point) 'sldb-reference)
+    (case where
+      (:ansi-cl
+       (case type
+         (:section
+          (browse-url (funcall common-lisp-hyperspec-section-fun what)))
+         (:glossary
+          (browse-url (funcall common-lisp-glossary-fun what)))
+         (:issue
+          (browse-url (funcall 'common-lisp-issuex what)))
+         (t
+          (hyperspec-lookup what))))
+      (t
+       (let ((url (format "%s%s.html" slime-sbcl-manual-root
+                          (subst-char-in-string ?\  ?\- what))))
+         (browse-url url))))))
+
+(defun sldb-maybe-insert-references (extra)
+  (destructure-case extra
+    ((:references references)
+     (when references
+       (insert "\nSee also:")
+       (slime-with-rigid-indentation 2
+	 (sldb-insert-references references)))
+     t)
+    (t nil)))
+
+
+;;; Initialization
+
+(defun slime-references-init ()
+  (setq slime-tree-printer 'slime-tree-print-with-references)
+  (add-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
+
+(defun slime-references-unload ()
+  (setq slime-tree-printer 'slime-tree-default-printer)
+  (remove-hook 'sldb-extras-hooks 'sldb-maybe-insert-references))
+  
+(provide 'slime-references)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-scratch.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,48 @@
+;;; slime-scratch.el --- imitate Emacs' *scratch* buffer
+;;
+;; Author: Helmut Eller  <heller at common-lisp.net>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path ".../slime/contrib")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-scratch)))
+;;
+
+
+;;; Code
+
+(defvar slime-scratch-mode-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map lisp-mode-map)
+    map))
+
+(defun slime-scratch ()
+  (interactive)
+  (slime-switch-to-scratch-buffer))
+
+(defun slime-switch-to-scratch-buffer ()
+  (set-buffer (slime-scratch-buffer))
+  (unless (eq (current-buffer) (window-buffer))
+    (pop-to-buffer (current-buffer) t)))
+
+(defun slime-scratch-buffer ()
+  "Return the scratch buffer, create it if necessary."
+  (or (get-buffer "*slime-scratch*")
+      (with-current-buffer (get-buffer-create "*slime-scratch*")
+	(lisp-mode)
+	(use-local-map slime-scratch-mode-map)
+	(slime-mode t)
+	(current-buffer))))
+
+(slime-define-keys slime-scratch-mode-map
+  ("\C-j" 'slime-eval-print-last-expression))
+
+(defun slime-scratch-init ()
+  (def-slime-selector-method ?s
+    "*slime-scratch* buffer."
+    (slime-scratch-buffer)))
+
+(provide 'slime-scratch)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-tramp.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,55 @@
+;;; slime-tramp.el ---  Filename translations for tramp
+;;
+;; Authors: Marco Baringer <mb at bese.it>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path ".../slime/contrib")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-tramp)))
+;;
+
+(defun slime-make-tramp-file-name (username remote-host lisp-filename)
+  "Old (with multi-hops) tramp compatability function"
+  (require 'tramp)
+  (if (boundp 'tramp-multi-methods)
+      (tramp-make-tramp-file-name nil nil
+                                  username
+                                  remote-host
+                                  lisp-filename)
+      (tramp-make-tramp-file-name nil
+                                  username
+                                  remote-host
+                                  lisp-filename)))
+
+(defun* slime-create-filename-translator (&key machine-instance
+                                         remote-host
+                                         username)
+  "Creates a three element list suitable for push'ing onto
+slime-filename-translations which uses Tramp to load files on
+hostname using username. MACHINE-INSTANCE is a required
+parameter, REMOTE-HOST defaults to MACHINE-INSTANCE and USERNAME
+defaults to (user-login-name).
+
+MACHINE-INSTANCE is the value returned by slime-machine-instance,
+which is just the value returned by cl:machine-instance on the
+remote lisp. REMOTE-HOST is the fully qualified domain name (or
+just the IP) of the remote machine. USERNAME is the username we
+should login with.
+The functions created here expect your tramp-default-method or
+ tramp-default-method-alist to be setup correctly."
+  (lexical-let ((remote-host (or remote-host machine-instance))
+                (username (or username (user-login-name))))
+    (list (concat "^" machine-instance "$")
+          (lambda (emacs-filename)
+            (tramp-file-name-localname
+             (tramp-dissect-file-name emacs-filename)))
+          `(lambda (lisp-filename)
+            (slime-make-tramp-file-name
+             ,username
+             ,remote-host
+             lisp-filename)))))
+
+(provide 'slime-tramp)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,91 @@
+;;; slime-typeout-frame.el --- display some message in a dedicated frame
+;;
+;; Author: Luke Gorrie  <luke at synap.se>
+;; License: GNU GPL (same license as Emacs)
+;;
+;;; Installation:
+;;
+;; Add something like this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-typeout-frame)))
+;;
+
+
+;;;; Typeout frame
+
+;; When a "typeout frame" exists it is used to display certain
+;; messages instead of the echo area or pop-up windows.
+
+(defvar slime-typeout-window nil
+  "The current typeout window.")
+
+(defvar slime-typeout-frame-properties
+  '((height . 10) (minibuffer . nil))
+  "The typeout frame properties (passed to `make-frame').")
+
+(defun slime-typeout-active-p ()
+  (and slime-typeout-window
+       (window-live-p slime-typeout-window)))
+
+(defun slime-typeout-message-aux (format-string &rest format-args)
+  (slime-ensure-typeout-frame)
+  (with-current-buffer (window-buffer slime-typeout-window)
+    (let ((msg (apply #'format format-string format-args)))
+      (unless (string= msg "")
+	(erase-buffer)
+	(insert msg)))))
+
+(defun slime-typeout-message (format-string &rest format-args)
+  (apply #'slime-typeout-message-aux format-string format-args)
+  ;; Disable the timer for autodoc temporarily, as it would overwrite
+  ;; the current typeout message otherwise.
+  (when (and (featurep 'slime-autodoc) slime-autodoc-mode)
+    (slime-autodoc-stop-timer)
+    (add-hook 'pre-command-hook #'slime-autodoc-start-timer)))
+
+(defun slime-make-typeout-frame ()
+  "Create a frame for displaying messages (e.g. arglists)."
+  (interactive)
+  (let ((frame (make-frame slime-typeout-frame-properties)))
+    (save-selected-window
+      (select-window (frame-selected-window frame))
+      (switch-to-buffer "*SLIME-Typeout*")
+      (setq slime-typeout-window (selected-window)))))
+
+(defun slime-ensure-typeout-frame ()
+  "Create the typeout frame unless it already exists."
+  (interactive)
+  (unless (slime-typeout-active-p)
+    (slime-make-typeout-frame)))
+
+(defun slime-typeout-autodoc-message (doc)
+  ;; No need for refreshing per `slime-autodoc-pre-command-refresh-echo-area'.
+  (setq slime-autodoc-last-message "")
+  (slime-typeout-message-aux "%s" doc))
+
+
+;;; Initialization
+
+(defvar slime-typeout-frame-unbind-stack ())
+
+(defun slime-typeout-frame-init ()
+  (add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+  (loop for (var value) in 
+	'((slime-message-function slime-typeout-message)
+	  (slime-background-message-function slime-typeout-message)
+	  (slime-autodoc-message-function slime-typeout-autodoc-message))
+	do (slime-typeout-frame-init-var var value)))
+
+(defun slime-typeout-frame-init-var (var value)
+  (push (list var (if (boundp var) (symbol-value var) 'slime-unbound))
+	slime-typeout-frame-unbind-stack)
+  (set var value))
+
+(defun slime-typeout-frame-unload ()
+  (remove-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+  (loop for (var value) in slime-typeout-frame-unbind-stack 
+	do (cond ((eq var 'slime-unbound) (makunbound var))
+		 (t (set var value)))))
+  
+(provide 'slime-typeout-frame)

Added: branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/slime-xref-browser.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,104 @@
+;;; slime-xref-browser.el --- xref browsing with tree-widget
+;;
+;; Author: Rui Patrocínio <rui.patrocinio at netvisao.pt>
+;; Licencse: GNU GPL (same license as Emacs)
+;; 
+;;; Installation:
+;;
+;; Add this to your .emacs: 
+;;
+;;   (add-to-list 'load-path "<directory-of-this-file>")
+;;   (add-hook 'slime-load-hook (lambda () (require 'slime-xref-browser)))
+;;
+
+
+;;;; classes browser
+
+(defun slime-expand-class-node (widget)
+  (or (widget-get widget :args)
+      (let ((name (widget-get widget :tag)))
+	(loop for kid in (slime-eval `(swank:mop :subclasses ,name))
+	      collect `(tree-widget :tag ,kid
+				    :dynargs slime-expand-class-node
+				    :has-children t)))))
+
+(defun slime-browse-classes (name)
+  "Read the name of a class and show its subclasses."
+  (interactive (list (slime-read-symbol-name "Class Name: ")))
+  (slime-call-with-browser-setup 
+   "*slime class browser*" (slime-current-package) "Class Browser"
+   (lambda ()
+     (widget-create 'tree-widget :tag name 
+                    :dynargs 'slime-expand-class-node 
+                    :has-echildren t))))
+
+(defvar slime-browser-map nil
+  "Keymap for tree widget browsers")
+
+(require 'tree-widget)
+(unless slime-browser-map
+  (setq slime-browser-map (make-sparse-keymap))
+  (set-keymap-parent slime-browser-map widget-keymap)
+  (define-key slime-browser-map "q" 'bury-buffer))
+
+(defun slime-call-with-browser-setup (buffer package title fn)
+  (switch-to-buffer buffer)
+  (kill-all-local-variables)
+  (setq slime-buffer-package package)
+  (let ((inhibit-read-only t)) (erase-buffer))
+  (widget-insert title "\n\n")
+  (save-excursion
+    (funcall fn))
+  (lisp-mode-variables t)
+  (slime-mode t)
+  (use-local-map slime-browser-map)
+  (widget-setup))
+
+
+;;;; Xref browser
+
+(defun slime-fetch-browsable-xrefs (type name)
+  "Return a list ((LABEL DSPEC)).
+LABEL is just a string for display purposes. 
+DSPEC can be used to expand the node."
+  (let ((xrefs '()))
+    (loop for (_file . specs) in (slime-eval `(swank:xref ,type ,name)) do
+          (loop for (dspec . _location) in specs do
+                (let ((exp (ignore-errors (read (downcase dspec)))))
+                  (cond ((and (consp exp) (eq 'flet (car exp)))
+                         ;; we can't expand FLET references so they're useless
+                         )
+                        ((and (consp exp) (eq 'method (car exp)))
+                         ;; this isn't quite right, but good enough for now
+                         (push (list dspec (string (second exp))) xrefs))
+                        (t
+                         (push (list dspec dspec) xrefs))))))
+    xrefs))
+
+(defun slime-expand-xrefs (widget)
+  (or (widget-get widget :args)
+      (let* ((type (widget-get widget :xref-type))
+             (dspec (widget-get widget :xref-dspec))
+             (xrefs (slime-fetch-browsable-xrefs type dspec)))
+        (loop for (label dspec) in xrefs
+              collect `(tree-widget :tag ,label
+                                    :xref-type ,type
+                                    :xref-dspec ,dspec
+                                    :dynargs slime-expand-xrefs
+                                    :has-children t)))))
+
+(defun slime-browse-xrefs (name type)
+  "Show the xref graph of a function in a tree widget."
+  (interactive 
+   (list (slime-read-from-minibuffer "Name: "
+                                     (slime-symbol-name-at-point))
+         (read (completing-read "Type: " (slime-bogus-completion-alist
+                                          '(":callers" ":callees" ":calls"))
+                                nil t ":"))))
+  (slime-call-with-browser-setup 
+   "*slime xref browser*" (slime-current-package) "Xref Browser"
+   (lambda ()
+     (widget-create 'tree-widget :tag name :xref-type type :xref-dspec name 
+                    :dynargs 'slime-expand-xrefs :has-echildren t))))
+
+(provide 'slime-xref-browser)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1217 @@
+;;; swank-arglists.lisp --- arglist related code ??
+;;
+;; Authors: Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          and others 
+;;
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (swank-require :swank-c-p-c))
+
+(defun valid-operator-symbol-p (symbol)
+  "Is SYMBOL the name of a function, a macro, or a special-operator?"
+  (or (fboundp symbol)
+      (macro-function symbol)
+      (special-operator-p symbol)
+      (eq symbol 'declare)))
+  
+(defun valid-operator-name-p (string)
+  "Is STRING the name of a function, macro, or special-operator?"
+  (let ((symbol (parse-symbol string)))
+    (valid-operator-symbol-p symbol)))
+
+(defslimefun arglist-for-echo-area (raw-specs &key arg-indices
+                                                   print-right-margin print-lines)
+  "Return the arglist for the first valid ``form spec'' in
+RAW-SPECS. A ``form spec'' is a superset of functions, macros,
+special-ops, declarations and type specifiers.
+
+For more information about the format of ``raw form specs'' and
+``form specs'', please see PARSE-FORM-SPEC."
+  (handler-case 
+      (with-buffer-syntax ()
+        (multiple-value-bind (form-spec position newly-interned-symbols)
+            (parse-first-valid-form-spec raw-specs #'read-conversatively-for-autodoc)
+          (unwind-protect
+               (when form-spec
+                 (let ((arglist (arglist-from-form-spec form-spec :remove-args nil)))
+                   (unless (eql arglist :not-available)
+                     (multiple-value-bind (type operator arguments)
+                         (split-form-spec form-spec)
+                       (declare (ignore arguments))
+                       (multiple-value-bind (stringified-arglist)
+                           (decoded-arglist-to-string
+                            arglist
+                            :operator operator
+                            :print-right-margin print-right-margin
+                            :print-lines print-lines
+                            :highlight (let ((index (nth position arg-indices)))
+					 ;; don't highlight the operator
+					 (and index (not (zerop index)) index)))
+			 ;; Post formatting:
+                         (case type
+                           (:type-specifier (format nil "[Typespec] ~A" stringified-arglist))
+                           (:declaration
+			    (locally (declare (special *arglist-pprint-bindings*))
+			      (with-bindings *arglist-pprint-bindings*
+				(let ((op (%find-declaration-operator raw-specs position)))
+				  (if op
+				      (format nil "(~A ~A)" op stringified-arglist)
+				      (format nil "[Declaration] ~A" stringified-arglist))))))
+                           (t stringified-arglist)))))))
+            (mapc #'unintern-in-home-package newly-interned-symbols))))
+    (error (cond)
+      (format nil "ARGLIST (error): ~A" cond))
+    ))
+
+(defun %find-declaration-operator (raw-specs position)
+  (let ((op-rawspec (nth (1+ position) raw-specs)))
+    (first (parse-form-spec op-rawspec #'read-conversatively-for-autodoc))))
+
+(defvar *arglist-dummy* (cons :dummy nil))
+
+(defun read-conversatively-for-autodoc (string)
+  "Tries to find the symbol that's represented by STRING. 
+
+If it can't, this either means that STRING does not represent a
+symbol, or that the symbol behind STRING would have to be freshly
+interned. Because this function is supposed to be called from the
+automatic arglist display stuff from Slime, interning freshly
+symbols is a big no-no.
+
+In such a case (that no symbol could be found), the object
+*ARGLIST-DUMMY* is returned instead, which works as a placeholder
+datum for subsequent logics to rely on."
+  (let* ((string  (string-left-trim '(#\Space #\Tab #\Newline) string))
+	 (quoted? (eql (aref string 0) #\')))
+    (multiple-value-bind (symbol found?)
+	(parse-symbol (if quoted? (subseq string 1) string))
+      (if found?
+	  (if quoted? `(quote ,symbol) symbol)
+	  *arglist-dummy*))))
+
+
+(defun parse-form-spec (raw-spec &optional reader)
+  "Takes a raw (i.e. unparsed) form spec from SLIME and returns a
+proper form spec for further processing within SWANK. Returns NIL
+if RAW-SPEC could not be parsed. Symbols that had to be interned
+in course of the conversion, are returned as secondary return value.
+
+A ``raw form spec'' can be either: 
+
+  i)   a list of strings representing a Common Lisp form
+
+  ii)  a list of strings as of i), but which additionally 
+       contains other raw form specs
+
+  iii) one of:
+
+     a)  (:declaration declspec) 
+
+           where DECLSPEC is a raw form spec.
+
+     b)  (:type-specifier typespec) 
+       
+           where TYPESPEC is a raw form spec.
+
+
+A ``form spec'' is either
+
+  1) a normal Common Lisp form
+
+  2) a Common Lisp form with a list as its CAR specifying what namespace
+     the operator is supposed to be interpreted in:
+
+       a) ((:declaration decl-identifier) declarg1 declarg2 ...)
+
+       b) ((:type-specifier typespec-op) typespec-arg1 typespec-arg2 ...)
+
+
+Examples:
+
+  (\"defmethod\")                               =>  (defmethod)
+  (\"cl:defmethod\")                            =>  (cl:defmethod)
+  (\"defmethod\" \"print-object\")              =>  (defmethod print-object)
+
+  (\"foo\" (\"bar\" (\"quux\")) \"baz\"         =>  (foo (bar (quux)) baz)
+
+  (:declaration \"optimize\" \"(optimize)\")    =>  ((:declaration optimize))
+  (:declaration \"type\"     \"(type string)\") =>  ((:declaration type) string)
+  (:type-specifier \"float\" \"(float)\")       =>  ((:type-specifier float))
+  (:type-specifier \"float\" \"(float 0 100)\") =>  ((:type-specifier float) 0 100)
+"
+  (flet ((parse-extended-spec (raw-extension extension-flag)
+           (when (and (stringp (first raw-extension)) ; (:DECLARATION (("a" "b" ("c")) "d"))
+                      (nth-value 1 (parse-symbol (first raw-extension))))
+	     (multiple-value-bind (extension introduced-symbols)
+                 (read-form-spec raw-extension reader)
+	       (unless (recursively-empty-p extension) ; (:DECLARATION (())) &c.
+                 (destructuring-bind (identifier &rest args) extension
+                   (values `((,extension-flag ,identifier) , at args)
+                           introduced-symbols)))))))
+    (when (consp raw-spec)
+      (destructure-case raw-spec
+        ((:declaration raw-declspec)
+         (parse-extended-spec raw-declspec :declaration))
+        ((:type-specifier raw-typespec)
+         (parse-extended-spec raw-typespec :type-specifier))
+        (t
+         (when (every #'(lambda (x) (or (stringp x) (consp x))) raw-spec)
+           (destructuring-bind (raw-operator &rest raw-args) raw-spec
+             (multiple-value-bind (operator found?) (parse-symbol raw-operator)
+               (when (and found? (valid-operator-symbol-p operator))
+                 (multiple-value-bind (parsed-args introduced-symbols)
+                     (read-form-spec raw-args reader)
+                   (values `(,operator , at parsed-args) introduced-symbols)))))))))))
+
+
+(defun split-form-spec (spec)
+  "Returns all three relevant information a ``form spec''
+contains: the operator type, the operator, and the operands."
+  (destructuring-bind (operator-designator &rest arguments) spec
+    (multiple-value-bind (type operator)
+        (if (listp operator-designator)
+            (values (first operator-designator) (second operator-designator))
+            (values :function operator-designator)) ; functions, macros, special ops
+      (values type operator arguments))))           ;  are all fbound.
+
+(defun parse-first-valid-form-spec (raw-specs &optional reader)
+  "Returns the first parsed form spec in RAW-SPECS that can
+successfully be parsed. Additionally returns that spec's position
+as secondary, and all newly interned symbols as tertiary return
+value."
+  (loop for raw-spec in raw-specs
+	for pos upfrom 0
+	do (multiple-value-bind (spec symbols) (parse-form-spec raw-spec reader)
+	     (when spec (return (values spec pos symbols))))))
+
+(defun read-form-spec (spec &optional reader)
+  "Turns the ``raw form spec'' SPEC into a proper Common Lisp
+form. As secondary return value, it returns all the symbols that
+had to be newly interned during the conversion.
+
+READER is a function that takes a string, and returns two values:
+the Common Lisp datum that the string represents, a flag whether
+the returned datum is a symbol and has been newly interned in
+some package.
+
+If READER is not explicitly given, the function READ-SOFTLY is
+used instead."
+  (when spec
+    (with-buffer-syntax ()
+      (call-with-ignored-reader-errors
+       #'(lambda ()
+           (let ((result) (newly-interned-symbols) (ok))
+             (unwind-protect
+                  (dolist (element spec (setq ok t))
+                    (etypecase element
+                      (string
+                       (multiple-value-bind (sexp newly-interned?)
+                           (funcall (or reader 'read-softly) element)
+                         (push sexp result)
+                         (when newly-interned?
+                           (push sexp newly-interned-symbols))))
+                      (cons
+                       (multiple-value-bind (read-spec interned-symbols)
+                           (read-form-spec element)
+                         (push read-spec result)
+                         (setf newly-interned-symbols
+                               (append interned-symbols
+                                       newly-interned-symbols))))))
+               (unless ok
+                 (mapc #'unintern-in-home-package newly-interned-symbols)))
+             (values (nreverse result)
+                     (nreverse newly-interned-symbols))))))))
+
+(defun unintern-in-home-package (symbol)
+  (unintern symbol (symbol-package symbol)))
+
+(defun read-softly (string)
+  "Returns two values:
+
+     1. the object resulting from READing STRING.
+
+     2. T if the object is a symbol that had to be newly interned
+        in some package. (This does not work for symbols in
+        compound forms like lists or vectors.)"
+  (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string)
+    (if found?
+        (values symbol nil)
+        (let ((sexp (read-from-string string)))
+          (values sexp
+                  (when (symbolp sexp)
+                    (prog1 t
+                      ;; assert that PARSE-SYMBOL didn't parse incorrectly.
+                      (assert (and (equal symbol-name (symbol-name sexp))
+                                   (eq package (symbol-package sexp)))))))))))
+
+
+(defstruct (arglist (:conc-name arglist.) (:predicate arglist-p))
+  provided-args         ; list of the provided actual arguments
+  required-args         ; list of the required arguments
+  optional-args         ; list of the optional arguments
+  key-p                 ; whether &key appeared
+  keyword-args          ; list of the keywords
+  rest                  ; name of the &rest or &body argument (if any)
+  body-p                ; whether the rest argument is a &body
+  allow-other-keys-p    ; whether &allow-other-keys appeared
+  aux-args              ; list of &aux variables
+  any-p                 ; whether &any appeared
+  any-args              ; list of &any arguments  [*]
+  known-junk            ; &whole, &environment
+  unknown-junk)         ; unparsed stuff
+
+;;;
+;;; [*] The &ANY lambda keyword is an extension to ANSI Common Lisp,
+;;;     and is only used to describe certain arglists that cannot be
+;;;     described in another way. 
+;;;
+;;;     &ANY is very similiar to &KEY but while &KEY is based upon
+;;;     the idea of a plist (key1 value1 key2 value2), &ANY is a
+;;;     cross between &OPTIONAL, &KEY and *FEATURES* lists:
+;;;
+;;;        a) (&ANY :A :B :C) means that you can provide any (non-null)
+;;;              set consisting of the keywords `:A', `:B', or `:C' in
+;;;              the arglist. E.g. (:A) or (:C :B :A).
+;;;
+;;;        (This is not restricted to keywords only, but any self-evaluating
+;;;         expression is allowed.)
+;;;
+;;;        b) (&ANY (key1 v1) (key2 v2) (key3 v3)) means that you can
+;;;              provide any (non-null) set consisting of lists where
+;;;              the CAR of the list is one of `key1', `key2', or `key3'.
+;;;              E.g. ((key1 100) (key3 42)), or ((key3 66) (key2 23))
+;;;
+;;;
+;;;     For example, a) let us describe the situations of EVAL-WHEN as
+;;;
+;;;       (EVAL-WHEN (&ANY :compile-toplevel :load-toplevel :execute) &BODY body)
+;;;
+;;;     and b) let us describe the optimization qualifiers that are valid
+;;;     in the declaration specifier `OPTIMIZE':
+;;;
+;;;       (DECLARE (OPTIMIZE &ANY (compilation-speed 1) (safety 1) ...))
+;;;
+
+(defun print-arglist (arglist &key operator highlight)
+  (let ((index 0)
+        (need-space nil))
+    (labels ((print-arg (arg)
+               (typecase arg
+                 (arglist               ; destructuring pattern
+                  (print-arglist arg))
+                 (optional-arg 
+                  (princ (encode-optional-arg arg)))
+                 (keyword-arg
+                  (let ((enc-arg (encode-keyword-arg arg)))
+                    (etypecase enc-arg
+                      (symbol (princ enc-arg))
+                      ((cons symbol) 
+                       (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+                         (princ (car enc-arg))
+                         (write-char #\space)
+                         (pprint-fill *standard-output* (cdr enc-arg) nil)))
+                      ((cons cons)
+                       (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+                         (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+                           (prin1 (caar enc-arg))
+                           (write-char #\space)
+                           (print-arg (keyword-arg.arg-name arg)))
+                         (unless (null (cdr enc-arg))
+                           (write-char #\space))
+                         (pprint-fill *standard-output* (cdr enc-arg) nil))))))
+                 (t           ; required formal or provided actual arg
+                  (if (keywordp arg)
+		      (prin1 arg)	; for &ANY args.
+		      (princ arg)))))
+             (print-space ()
+               (ecase need-space
+                 ((nil))
+                 ((:miser)
+                  (write-char #\space)
+                  (pprint-newline :miser))
+                 ((t)
+                  (write-char #\space)
+                  (pprint-newline :fill)))
+               (setq need-space t))
+             (print-with-space (obj)
+               (print-space)
+               (print-arg obj))
+             (print-with-highlight (arg &optional (index-ok-p #'=))
+               (print-space)
+               (cond 
+                 ((and highlight (funcall index-ok-p index highlight))
+                  (princ "===> ")
+                  (print-arg arg)
+                  (princ " <==="))
+                 (t
+                  (print-arg arg)))
+               (incf index)))
+      (pprint-logical-block (nil nil :prefix "(" :suffix ")")
+        (when operator
+          (print-with-highlight operator)
+          (setq need-space :miser))
+	(mapc #'print-with-highlight
+	      (arglist.provided-args arglist))
+        (mapc #'print-with-highlight
+              (arglist.required-args arglist))
+        (when (arglist.optional-args arglist)
+          (print-with-space '&optional)
+          (mapc #'print-with-highlight 
+                (arglist.optional-args arglist)))
+        (when (arglist.key-p arglist)
+          (print-with-space '&key)
+          (mapc #'print-with-space
+                (arglist.keyword-args arglist)))
+        (when (arglist.allow-other-keys-p arglist)
+          (print-with-space '&allow-other-keys))
+        (when (arglist.any-args arglist)
+          (print-with-space '&any)
+          (mapc #'print-with-space
+                (arglist.any-args arglist)))
+        (cond ((not (arglist.rest arglist)))
+              ((arglist.body-p arglist)
+               (print-with-space '&body)
+               (print-with-highlight (arglist.rest arglist) #'<=))
+              (t
+               (print-with-space '&rest)
+               (print-with-highlight (arglist.rest arglist) #'<=)))
+        (mapc #'print-with-space                 
+              (arglist.unknown-junk arglist))))))  
+
+(defvar *arglist-pprint-bindings*
+  '((*print-case*     . :downcase)
+    (*print-pretty*   . t)
+    (*print-circle*   . nil)
+    (*print-readably* . nil)
+    (*print-level*    . 10)
+    (*print-length*   . 20)
+    (*print-escape*   . nil))) ; no package qualifiers.
+
+(defun decoded-arglist-to-string (arglist
+                                  &key operator highlight (package *package*)
+                                  print-right-margin print-lines)
+  "Print the decoded ARGLIST for display in the echo area.  The
+argument name are printed without package qualifiers and pretty
+printing of (function foo) as #'foo is suppressed.  If HIGHLIGHT is
+non-nil, it must be the index of an argument; highlight this argument.
+If OPERATOR is non-nil, put it in front of the arglist."
+  (with-output-to-string (*standard-output*)
+    (with-standard-io-syntax
+      (with-bindings *arglist-pprint-bindings*
+	(let ((*package* package)
+	      (*print-right-margin* print-right-margin)
+	      (*print-lines* print-lines))       
+	  (print-arglist arglist :operator operator :highlight highlight))))))
+
+(defslimefun variable-desc-for-echo-area (variable-name)
+  "Return a short description of VARIABLE-NAME, or NIL."
+  (with-buffer-syntax ()
+    (let ((sym (parse-symbol variable-name)))
+      (if (and sym (boundp sym))
+          (let ((*print-pretty* nil) (*print-level* 4)
+                (*print-length* 10) (*print-circle* t))
+             (format nil "~A => ~A" sym (symbol-value sym)))))))
+
+(defun decode-required-arg (arg)
+  "ARG can be a symbol or a destructuring pattern."
+  (etypecase arg
+    (symbol arg)
+    (list   (decode-arglist arg))))
+
+(defun encode-required-arg (arg)
+  (etypecase arg
+    (symbol arg)
+    (arglist (encode-arglist arg))))
+
+(defstruct (keyword-arg 
+            (:conc-name keyword-arg.)
+            (:constructor make-keyword-arg (keyword arg-name default-arg)))
+  keyword
+  arg-name
+  default-arg)
+
+(defun decode-keyword-arg (arg)
+  "Decode a keyword item of formal argument list.
+Return three values: keyword, argument name, default arg."
+  (cond ((symbolp arg)
+         (make-keyword-arg (intern (symbol-name arg) keyword-package)
+                           arg
+                           nil))
+        ((and (consp arg)
+              (consp (car arg)))
+         (make-keyword-arg (caar arg)
+                           (decode-required-arg (cadar arg))
+                           (cadr arg)))
+        ((consp arg)
+         (make-keyword-arg (intern (symbol-name (car arg)) keyword-package)
+                           (car arg)
+                           (cadr arg)))
+        (t
+         (error "Bad keyword item of formal argument list"))))
+
+(defun encode-keyword-arg (arg)
+  (cond
+    ((arglist-p (keyword-arg.arg-name arg))
+     ;; Destructuring pattern
+     (let ((keyword/name (list (keyword-arg.keyword arg)
+                               (encode-required-arg
+                                (keyword-arg.arg-name arg)))))
+       (if (keyword-arg.default-arg arg)
+           (list keyword/name
+                 (keyword-arg.default-arg arg))
+           (list keyword/name))))
+    ((eql (intern (symbol-name (keyword-arg.arg-name arg)) 
+                  keyword-package)
+          (keyword-arg.keyword arg))
+     (if (keyword-arg.default-arg arg)
+         (list (keyword-arg.arg-name arg)
+               (keyword-arg.default-arg arg))
+         (keyword-arg.arg-name arg)))
+    (t
+     (let ((keyword/name (list (keyword-arg.keyword arg)
+                               (keyword-arg.arg-name arg))))
+       (if (keyword-arg.default-arg arg)
+           (list keyword/name
+                 (keyword-arg.default-arg arg))
+           (list keyword/name))))))
+
+(progn
+  (assert (equalp (decode-keyword-arg 'x) 
+                  (make-keyword-arg :x 'x nil)))
+  (assert (equalp (decode-keyword-arg '(x t)) 
+                  (make-keyword-arg :x 'x t)))
+  (assert (equalp (decode-keyword-arg '((:x y)))
+                  (make-keyword-arg :x 'y nil)))
+  (assert (equalp (decode-keyword-arg '((:x y) t))
+                  (make-keyword-arg :x 'y t))))
+
+(defstruct (optional-arg 
+            (:conc-name optional-arg.)
+            (:constructor make-optional-arg (arg-name default-arg)))
+  arg-name
+  default-arg)
+
+(defun decode-optional-arg (arg)
+  "Decode an optional item of a formal argument list.
+Return an OPTIONAL-ARG structure."
+  (etypecase arg
+    (symbol (make-optional-arg arg nil))
+    (list   (make-optional-arg (decode-required-arg (car arg)) 
+                               (cadr arg)))))
+
+(defun encode-optional-arg (optional-arg)
+  (if (or (optional-arg.default-arg optional-arg)
+          (arglist-p (optional-arg.arg-name optional-arg)))
+      (list (encode-required-arg
+             (optional-arg.arg-name optional-arg))
+            (optional-arg.default-arg optional-arg))
+      (optional-arg.arg-name optional-arg)))
+
+(progn
+  (assert (equalp (decode-optional-arg 'x)
+                  (make-optional-arg 'x nil)))
+  (assert (equalp (decode-optional-arg '(x t))
+                  (make-optional-arg 'x t))))
+
+(define-modify-macro nreversef () nreverse "Reverse the list in PLACE.")
+
+(defun decode-arglist (arglist)
+  "Parse the list ARGLIST and return an ARGLIST structure."
+  (let ((mode nil)
+        (result (make-arglist)))
+    (dolist (arg arglist)
+      (cond
+        ((eql mode '&unknown-junk)      
+         ;; don't leave this mode -- we don't know how the arglist
+         ;; after unknown lambda-list keywords is interpreted
+         (push arg (arglist.unknown-junk result)))
+        ((eql arg '&allow-other-keys)
+         (setf (arglist.allow-other-keys-p result) t))
+        ((eql arg '&key)
+         (setf (arglist.key-p result) t
+               mode arg))
+        ((member arg '(&optional &rest &body &aux))
+         (setq mode arg))
+        ((member arg '(&whole &environment))
+         (setq mode arg)
+         (push arg (arglist.known-junk result)))
+        ((and (symbolp arg)
+              (string= (symbol-name arg) (string '#:&ANY))) ; may be interned
+         (setf (arglist.any-p result) t)                    ;  in any *package*.
+         (setq mode '&any))
+        ((member arg lambda-list-keywords)
+         (setq mode '&unknown-junk)
+         (push arg (arglist.unknown-junk result)))
+        (t
+         (ecase mode
+	   (&key
+	    (push (decode-keyword-arg arg) 
+                  (arglist.keyword-args result)))
+	   (&optional
+	    (push (decode-optional-arg arg) 
+                  (arglist.optional-args result)))
+	   (&body
+	    (setf (arglist.body-p result) t
+                  (arglist.rest result) arg))
+	   (&rest
+            (setf (arglist.rest result) arg))
+	   (&aux
+            (push (decode-optional-arg arg)
+                  (arglist.aux-args result)))
+	   ((nil)
+	    (push (decode-required-arg arg)
+                  (arglist.required-args result)))
+           ((&whole &environment)
+            (setf mode nil)
+            (push arg (arglist.known-junk result)))
+           (&any
+            (push arg (arglist.any-args result)))))))
+    (nreversef (arglist.required-args result))
+    (nreversef (arglist.optional-args result))
+    (nreversef (arglist.keyword-args result))
+    (nreversef (arglist.aux-args result))
+    (nreversef (arglist.any-args result))
+    (nreversef (arglist.known-junk result))
+    (nreversef (arglist.unknown-junk result))
+    (assert (or (and (not (arglist.key-p result)) (not (arglist.any-p result)))
+                (exactly-one-p (arglist.key-p result) (arglist.any-p result))))
+    result))
+
+(defun encode-arglist (decoded-arglist)
+  (append (mapcar #'encode-required-arg (arglist.required-args decoded-arglist))
+          (when (arglist.optional-args decoded-arglist)
+            '(&optional))
+          (mapcar #'encode-optional-arg (arglist.optional-args decoded-arglist))
+          (when (arglist.key-p decoded-arglist)
+            '(&key))
+          (mapcar #'encode-keyword-arg (arglist.keyword-args decoded-arglist))
+          (when (arglist.allow-other-keys-p decoded-arglist)
+            '(&allow-other-keys))
+          (when (arglist.any-args decoded-arglist)
+            `(&any ,@(arglist.any-args decoded-arglist)))
+          (cond ((not (arglist.rest decoded-arglist)) 
+                 '())
+                ((arglist.body-p decoded-arglist)
+                 `(&body ,(arglist.rest decoded-arglist)))
+                (t
+                 `(&rest ,(arglist.rest decoded-arglist))))
+          (when (arglist.aux-args decoded-arglist)
+            `(&aux ,(arglist.aux-args decoded-arglist)))
+          (arglist.known-junk decoded-arglist)
+          (arglist.unknown-junk decoded-arglist)))
+
+(defun arglist-keywords (arglist)
+  "Return the list of keywords in ARGLIST.
+As a secondary value, return whether &allow-other-keys appears."
+  (let ((decoded-arglist (decode-arglist arglist)))
+    (values (arglist.keyword-args decoded-arglist)
+            (arglist.allow-other-keys-p decoded-arglist))))
+                                      
+(defun methods-keywords (methods)
+  "Collect all keywords in the arglists of METHODS.
+As a secondary value, return whether &allow-other-keys appears somewhere."
+  (let ((keywords '())
+	(allow-other-keys nil))
+    (dolist (method methods)
+      (multiple-value-bind (kw aok)
+	  (arglist-keywords
+	   (swank-mop:method-lambda-list method))
+	(setq keywords (remove-duplicates (append keywords kw)
+                                          :key #'keyword-arg.keyword)
+	      allow-other-keys (or allow-other-keys aok))))
+    (values keywords allow-other-keys)))
+
+(defun generic-function-keywords (generic-function)
+  "Collect all keywords in the methods of GENERIC-FUNCTION.
+As a secondary value, return whether &allow-other-keys appears somewhere."
+  (methods-keywords 
+   (swank-mop:generic-function-methods generic-function)))
+
+(defun applicable-methods-keywords (generic-function arguments)
+  "Collect all keywords in the methods of GENERIC-FUNCTION that are
+applicable for argument of CLASSES.  As a secondary value, return
+whether &allow-other-keys appears somewhere."
+  (methods-keywords
+   (multiple-value-bind (amuc okp)
+       (swank-mop:compute-applicable-methods-using-classes
+        generic-function (mapcar #'class-of arguments))
+     (if okp
+         amuc
+         (compute-applicable-methods generic-function arguments)))))
+
+(defun decoded-arglist-to-template-string (decoded-arglist package &key (prefix "(") (suffix ")"))
+  (with-output-to-string (*standard-output*)
+    (with-standard-io-syntax
+      (let ((*package* package) (*print-case* :downcase)
+            (*print-pretty* t) (*print-circle* nil) (*print-readably* nil)
+            (*print-level* 10) (*print-length* 20))
+        (print-decoded-arglist-as-template decoded-arglist 
+                                           :prefix prefix 
+                                           :suffix suffix)))))
+
+(defun print-decoded-arglist-as-template (decoded-arglist &key
+                                          (prefix "(") (suffix ")"))
+  (pprint-logical-block (nil nil :prefix prefix :suffix suffix)  
+    (let ((first-p t))
+      (flet ((space ()
+               (unless first-p
+                 (write-char #\space)
+                 (pprint-newline :fill))
+               (setq first-p nil))
+             (print-arg-or-pattern (arg)
+               (etypecase arg
+                 (symbol (if (keywordp arg) (prin1 arg) (princ arg)))
+                 (string (princ arg))
+                 (list   (princ arg))
+                 (arglist (print-decoded-arglist-as-template arg)))))
+        (dolist (arg (arglist.required-args decoded-arglist))
+          (space)
+          (print-arg-or-pattern arg))
+        (dolist (arg (arglist.optional-args decoded-arglist))
+          (space) 
+          (princ "[")
+          (print-arg-or-pattern (optional-arg.arg-name arg))
+          (princ "]"))
+        (dolist (keyword-arg (arglist.keyword-args decoded-arglist))
+          (space)
+          (let ((arg-name (keyword-arg.arg-name keyword-arg))
+                (keyword (keyword-arg.keyword keyword-arg)))
+            (format t "~W " 
+                    (if (keywordp keyword) keyword `',keyword))
+            (print-arg-or-pattern arg-name)))
+        (dolist (any-arg (arglist.any-args decoded-arglist))
+          (space)
+          (print-arg-or-pattern any-arg))
+        (when (and (arglist.rest decoded-arglist)
+                   (or (not (arglist.keyword-args decoded-arglist))
+                       (arglist.allow-other-keys-p decoded-arglist)))
+          (if (arglist.body-p decoded-arglist)
+              (pprint-newline :mandatory)
+              (space))
+          (format t "~A..." (arglist.rest decoded-arglist)))))
+    (pprint-newline :fill)))
+
+
+(defgeneric extra-keywords (operator &rest args)
+   (:documentation "Return a list of extra keywords of OPERATOR (a
+symbol) when applied to the (unevaluated) ARGS.  
+As a secondary value, return whether other keys are allowed.  
+As a tertiary value, return the initial sublist of ARGS that was needed 
+to determine the extra keywords."))
+
+(defun keywords-of-operator (operator)
+  "Return a list of KEYWORD-ARGs that OPERATOR accepts.
+This function is useful for writing EXTRA-KEYWORDS methods for
+user-defined functions which are declared &ALLOW-OTHER-KEYS and which
+forward keywords to OPERATOR."
+  (let ((arglist (arglist-from-form-spec (ensure-list operator) 
+                                         :remove-args nil)))
+    (unless (eql arglist :not-available)
+      (values 
+       (arglist.keyword-args arglist)
+       (arglist.allow-other-keys-p arglist)))))
+
+(defmethod extra-keywords (operator &rest args)
+  ;; default method
+  (declare (ignore args))
+  (let ((symbol-function (symbol-function operator)))
+    (if (typep symbol-function 'generic-function)
+        (generic-function-keywords symbol-function)
+        nil)))
+
+(defun class-from-class-name-form (class-name-form)
+  (when (and (listp class-name-form)
+             (= (length class-name-form) 2)
+             (eq (car class-name-form) 'quote))
+    (let* ((class-name (cadr class-name-form))
+           (class (find-class class-name nil)))
+      (when (and class
+                 (not (swank-mop:class-finalized-p class)))
+        ;; Try to finalize the class, which can fail if
+        ;; superclasses are not defined yet
+        (handler-case (swank-mop:finalize-inheritance class)
+          (program-error (c)
+            (declare (ignore c)))))
+      class)))
+    
+(defun extra-keywords/slots (class)
+  (multiple-value-bind (slots allow-other-keys-p)
+      (if (swank-mop:class-finalized-p class)
+          (values (swank-mop:class-slots class) nil)
+          (values (swank-mop:class-direct-slots class) t))
+    (let ((slot-init-keywords
+           (loop for slot in slots append 
+                 (mapcar (lambda (initarg)
+                           (make-keyword-arg 
+                            initarg
+                            (swank-mop:slot-definition-name slot)
+                            (swank-mop:slot-definition-initform slot)))
+                         (swank-mop:slot-definition-initargs slot)))))
+      (values slot-init-keywords allow-other-keys-p))))
+
+(defun extra-keywords/make-instance (operator &rest args)
+  (declare (ignore operator))
+  (unless (null args)
+    (let* ((class-name-form (car args))
+           (class (class-from-class-name-form class-name-form)))
+      (when class
+        (multiple-value-bind (slot-init-keywords class-aokp)
+            (extra-keywords/slots class)
+          (multiple-value-bind (allocate-instance-keywords ai-aokp)
+              (applicable-methods-keywords 
+               #'allocate-instance (list class))
+            (multiple-value-bind (initialize-instance-keywords ii-aokp)
+                (applicable-methods-keywords 
+                 #'initialize-instance (list (swank-mop:class-prototype class)))
+              (multiple-value-bind (shared-initialize-keywords si-aokp)
+                  (applicable-methods-keywords 
+                   #'shared-initialize (list (swank-mop:class-prototype class) t))
+                (values (append slot-init-keywords 
+                                allocate-instance-keywords
+                                initialize-instance-keywords
+                                shared-initialize-keywords)
+                        (or class-aokp ai-aokp ii-aokp si-aokp)
+                        (list class-name-form))))))))))
+
+(defun extra-keywords/change-class (operator &rest args)
+  (declare (ignore operator))
+  (unless (null args)
+    (let* ((class-name-form (car args))
+           (class (class-from-class-name-form class-name-form)))
+      (when class
+        (multiple-value-bind (slot-init-keywords class-aokp)
+            (extra-keywords/slots class)
+          (declare (ignore class-aokp))
+          (multiple-value-bind (shared-initialize-keywords si-aokp)
+              (applicable-methods-keywords
+               #'shared-initialize (list (swank-mop:class-prototype class) t))
+            ;; FIXME: much as it would be nice to include the
+            ;; applicable keywords from
+            ;; UPDATE-INSTANCE-FOR-DIFFERENT-CLASS, I don't really see
+            ;; how to do it: so we punt, always declaring
+            ;; &ALLOW-OTHER-KEYS.
+            (declare (ignore si-aokp))
+            (values (append slot-init-keywords shared-initialize-keywords)
+                    t
+                    (list class-name-form))))))))
+
+(defmacro multiple-value-or (&rest forms)
+  (if (null forms)
+      nil
+      (let ((first (first forms))
+            (rest (rest forms)))
+        `(let* ((values (multiple-value-list ,first))
+                (primary-value (first values)))
+          (if primary-value
+              (values-list values)
+              (multiple-value-or , at rest))))))
+
+(defmethod extra-keywords ((operator (eql 'make-instance))
+                           &rest args)
+  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                     (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'make-condition))
+                           &rest args)
+  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                     (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'error))
+                           &rest args)
+  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                     (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'signal))
+                           &rest args)
+  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                     (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'warn))
+                           &rest args)
+  (multiple-value-or (apply #'extra-keywords/make-instance operator args)
+                     (call-next-method)))
+
+(defmethod extra-keywords ((operator (eql 'cerror))
+                           &rest args)
+  (multiple-value-bind (keywords aok determiners)
+      (apply #'extra-keywords/make-instance operator
+             (cdr args))
+    (if keywords
+        (values keywords aok
+                (cons (car args) determiners))
+        (call-next-method))))
+
+(defmethod extra-keywords ((operator (eql 'change-class)) 
+                           &rest args)
+  (multiple-value-bind (keywords aok determiners)
+      (apply #'extra-keywords/change-class operator (cdr args))
+    (if keywords
+        (values keywords aok
+                (cons (car args) determiners))
+        (call-next-method))))
+
+(defun enrich-decoded-arglist-with-keywords (decoded-arglist keywords allow-other-keys-p)
+  "Modify DECODED-ARGLIST using KEYWORDS and ALLOW-OTHER-KEYS-P."
+  (when keywords
+    (setf (arglist.key-p decoded-arglist) t)
+    (setf (arglist.keyword-args decoded-arglist)
+          (remove-duplicates
+           (append (arglist.keyword-args decoded-arglist)
+                   keywords)
+           :key #'keyword-arg.keyword)))
+  (setf (arglist.allow-other-keys-p decoded-arglist)
+        (or (arglist.allow-other-keys-p decoded-arglist) 
+            allow-other-keys-p)))
+
+(defun enrich-decoded-arglist-with-extra-keywords (decoded-arglist form)
+  "Determine extra keywords from the function call FORM, and modify
+DECODED-ARGLIST to include them.  As a secondary return value, return
+the initial sublist of ARGS that was needed to determine the extra
+keywords.  As a tertiary return value, return whether any enrichment
+was done."
+  (multiple-value-bind (extra-keywords extra-aok determining-args)
+      (apply #'extra-keywords form)
+    ;; enrich the list of keywords with the extra keywords
+    (enrich-decoded-arglist-with-keywords decoded-arglist 
+                                          extra-keywords extra-aok)
+    (values decoded-arglist
+            determining-args
+            (or extra-keywords extra-aok))))
+
+(defgeneric compute-enriched-decoded-arglist (operator-form argument-forms)
+  (:documentation 
+   "Return three values: DECODED-ARGLIST, DETERMINING-ARGS, and
+ANY-ENRICHMENT, just like enrich-decoded-arglist-with-extra-keywords.
+If the arglist is not available, return :NOT-AVAILABLE."))
+
+(defmethod compute-enriched-decoded-arglist (operator-form argument-forms)
+  (let ((arglist (arglist operator-form)))
+    (etypecase arglist
+      ((member :not-available)
+       :not-available)
+      (list
+       (let ((decoded-arglist (decode-arglist arglist)))
+         (enrich-decoded-arglist-with-extra-keywords decoded-arglist 
+                                                     (cons operator-form 
+                                                           argument-forms)))))))
+
+(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'with-open-file))
+                                             argument-forms)
+  (declare (ignore argument-forms))
+  (multiple-value-bind (decoded-arglist determining-args)
+      (call-next-method)
+    (let ((first-arg (first (arglist.required-args decoded-arglist)))
+          (open-arglist (compute-enriched-decoded-arglist 'open nil)))
+      (when (and (arglist-p first-arg) (arglist-p open-arglist))
+        (enrich-decoded-arglist-with-keywords 
+         first-arg 
+         (arglist.keyword-args open-arglist)
+         nil)))
+    (values decoded-arglist determining-args t)))
+
+(defmethod compute-enriched-decoded-arglist ((operator-form (eql 'apply))
+                                             argument-forms)
+  (let ((function-name-form (car argument-forms)))
+    (when (and (listp function-name-form)
+               (length= function-name-form 2)
+               (member (car function-name-form) '(quote function)))
+      (let ((function-name (cadr function-name-form)))
+        (when (valid-operator-symbol-p function-name)
+          (let ((function-arglist 
+                 (compute-enriched-decoded-arglist function-name 
+                                                   (cdr argument-forms))))
+            (return-from compute-enriched-decoded-arglist
+              (values (make-arglist :required-args
+                                    (list 'function)
+                                    :optional-args 
+                                    (append 
+                                     (mapcar #'(lambda (arg)
+                                                 (make-optional-arg arg nil))
+                                             (arglist.required-args function-arglist))
+                                     (arglist.optional-args function-arglist))
+                                    :key-p 
+                                    (arglist.key-p function-arglist)
+                                    :keyword-args 
+                                    (arglist.keyword-args function-arglist)
+                                    :rest 
+                                    'args
+                                    :allow-other-keys-p 
+                                    (arglist.allow-other-keys-p function-arglist))
+                      (list function-name-form)
+                      t)))))))
+  (call-next-method))
+
+(defvar *remove-keywords-alist*
+  '((:test :test-not)
+    (:test-not :test)))
+
+(defun remove-actual-args (decoded-arglist actual-arglist)
+  "Remove from DECODED-ARGLIST the arguments that have already been
+provided in ACTUAL-ARGLIST."
+  (assert (or (and (not (arglist.key-p decoded-arglist))
+                   (not (arglist.any-p decoded-arglist)))
+              (exactly-one-p (arglist.key-p decoded-arglist)
+                             (arglist.any-p decoded-arglist))))
+  (loop while (and actual-arglist
+		   (arglist.required-args decoded-arglist))
+     do (progn (pop actual-arglist)
+	       (pop (arglist.required-args decoded-arglist))))
+  (loop while (and actual-arglist
+		   (arglist.optional-args decoded-arglist))
+     do (progn (pop actual-arglist)
+	       (pop (arglist.optional-args decoded-arglist))))
+  (if (arglist.any-p decoded-arglist)
+      (remove-&any-args decoded-arglist actual-arglist)
+      (remove-&key-args decoded-arglist actual-arglist))
+  decoded-arglist)
+
+(defun remove-&key-args (decoded-arglist key-args)
+  (loop for keyword in key-args by #'cddr
+        for keywords-to-remove = (cdr (assoc keyword *remove-keywords-alist*))
+        do (setf (arglist.keyword-args decoded-arglist)
+                 (remove-if (lambda (kw)
+                              (or (eql kw keyword)
+                                  (member kw keywords-to-remove)))
+                            (arglist.keyword-args decoded-arglist)
+                            :key #'keyword-arg.keyword)))  )
+
+(defun remove-&any-args (decoded-arglist any-args)
+  (setf (arglist.any-args decoded-arglist)
+        (remove-if #'(lambda (x) (member x any-args))
+                   (arglist.any-args decoded-arglist)
+                   :key #'(lambda (x) (first (ensure-list x))))))
+
+
+(defun arglist-from-form-spec (form-spec &key (remove-args t))
+  "Returns the decoded arglist that corresponds to FORM-SPEC. If
+REMOVE-ARGS is T, the arguments that are contained in FORM-SPEC
+are removed from the result arglist.
+
+Examples:
+
+  (arglist-from-form-spec '(defun)) 
+
+      ~=> (name args &body body)
+
+  (arglist-from-form-spec '(defun foo)) 
+
+      ~=> (args &body body)
+
+  (arglist-from-form-spec '(defun foo) :remove-args nil)) 
+
+      ~=>  (name args &body body))
+
+  (arglist-from-form-spec '((:type-specifier float) 42) :remove-args nil)
+
+      ~=> (&optional lower-limit upper-limit)
+"
+  (if (null form-spec)
+      :not-available
+      (multiple-value-bind (type operator arguments)
+          (split-form-spec form-spec)
+        (arglist-dispatch type operator arguments :remove-args remove-args))))
+
+
+(defmacro with-availability ((var) form &body body)
+  `(let ((,var ,form))
+     (if (eql ,var :not-available)
+         :not-available
+         (progn , at body))))
+
+(defgeneric arglist-dispatch (operator-type operator arguments &key remove-args))
+  
+(defmethod arglist-dispatch (operator-type operator arguments &key (remove-args t))
+  (when (and (symbolp operator)
+             (valid-operator-symbol-p operator))
+    (multiple-value-bind (decoded-arglist determining-args any-enrichment)
+        (compute-enriched-decoded-arglist operator arguments)
+      (etypecase decoded-arglist
+	((member :not-available)
+	 :not-available)
+	(arglist
+	 (cond 
+	   (remove-args
+	    ;; get rid of formal args already provided
+	    (remove-actual-args decoded-arglist arguments))
+	   (t
+	    ;; replace some formal args by determining actual args
+	    (remove-actual-args decoded-arglist determining-args)
+	    (setf (arglist.provided-args decoded-arglist)
+		  determining-args)))
+         (return-from arglist-dispatch
+           (values decoded-arglist any-enrichment))))))
+  :not-available)
+
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'defmethod))
+                             arguments &key (remove-args t))
+  (when (and (listp arguments)
+	     (not (null arguments)) ;have generic function name
+	     (notany #'listp (rest arguments))) ;don't have arglist yet 
+    (let* ((gf-name (first arguments))
+	   (gf (and (or (symbolp gf-name)
+			(and (listp gf-name)
+			     (eql (first gf-name) 'setf)))
+		    (fboundp gf-name)
+		    (fdefinition gf-name))))
+      (when (typep gf 'generic-function)
+        (with-availability (arglist) (arglist gf)
+          (return-from arglist-dispatch
+            (values (make-arglist :provided-args (if remove-args
+                                                     nil
+                                                     (list gf-name))
+                                  :required-args (list arglist)
+                                  :rest "body" :body-p t)
+                    t))))))
+  (call-next-method))
+
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'eval-when))
+                             arguments &key (remove-args t))
+  (let ((eval-when-args '(:compile-toplevel :load-toplevel :execute)))
+    (make-arglist :required-args (list (maybecall remove-args #'remove-actual-args
+						  (make-arglist :any-args eval-when-args)
+						  arguments))
+		  :rest '#:body :body-p t)))
+
+(defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'declare))
+                             arguments &key (remove-args t))
+  ;; Catching 'DECLARE before SWANK-BACKEND:ARGLIST can barf.
+  (declare (ignore remove-args))
+  (make-arglist :rest '#:decl-specifiers))
+
+(defmethod arglist-dispatch ((operator-type (eql :declaration))
+                             decl-identifier decl-args &key (remove-args t))
+  (with-availability (arglist)
+      (declaration-arglist decl-identifier)
+    (maybecall remove-args #'remove-actual-args
+               (decode-arglist arglist) decl-args))
+  ;; We don't fall back to CALL-NEXT-METHOD because we're within a
+  ;; different namespace! 
+  )
+
+(defmethod arglist-dispatch ((operator-type (eql :type-specifier))
+                             type-specifier specifier-args &key (remove-args t))
+  (with-availability (arglist)
+      (type-specifier-arglist type-specifier)
+    (maybecall remove-args #'remove-actual-args
+               (decode-arglist arglist) specifier-args))
+  ;; No CALL-NEXT-METHOD, see above.
+  )
+
+
+(defun read-incomplete-form-from-string (form-string)
+  (with-buffer-syntax ()
+    (call-with-ignored-reader-errors
+      #'(lambda ()
+          (read-from-string form-string)))))
+
+(defun call-with-ignored-reader-errors (thunk)
+  (declare (type (function () (values &rest t)) thunk))
+  (declare (optimize (speed 3) (safety 1)))
+  (handler-case (funcall thunk)
+    (reader-error (c)
+      (declare (ignore c))
+      nil)
+    (stream-error (c)
+      (declare (ignore c))
+      nil)))
+
+(defslimefun complete-form (form-string)
+  "Read FORM-STRING in the current buffer package, then complete it
+by adding a template for the missing arguments."
+  (multiple-value-bind (form newly-interned-symbols)
+      (parse-form-spec form-string)
+    (unwind-protect
+         (when (consp form)
+           (let ((form-completion (arglist-from-form-spec form)))
+             (unless (eql form-completion :not-available)
+               (return-from complete-form
+                 (decoded-arglist-to-template-string form-completion
+                                                     *buffer-package*
+                                                     :prefix "")))))
+      (mapc #'unintern-in-home-package newly-interned-symbols))
+    :not-available))
+
+
+(defun arglist-ref (decoded-arglist operator &rest indices)
+  (cond
+    ((null indices) decoded-arglist)
+    ((not (arglist-p decoded-arglist)) nil)
+    (t
+     (let ((index (first indices))
+           (args (append (and operator 
+                              (list operator))
+                         (arglist.required-args decoded-arglist)
+                         (arglist.optional-args decoded-arglist))))
+       (when (< index (length args))
+         (let ((arg (elt args index)))
+           (apply #'arglist-ref arg nil (rest indices))))))))
+
+(defslimefun completions-for-keyword (raw-specs keyword-string arg-index-specs)
+  (with-buffer-syntax ()
+    (multiple-value-bind (form-spec position newly-interned-symbols)
+        (parse-first-valid-form-spec raw-specs)
+      (unwind-protect
+	   (when form-spec
+	     (let ((arglist (arglist-from-form-spec form-spec  :remove-args nil)))
+	       (unless (eql arglist :not-available)
+		 (let* ((operator (nth-value 1 (split-form-spec form-spec)))
+			(indices  (reverse (rest (subseq arg-index-specs 0 (1+ position)))))
+			(arglist  (apply #'arglist-ref arglist operator indices)))
+		   (when (and arglist (arglist-p arglist))
+		     ;; It would be possible to complete keywords only if we
+		     ;; are in a keyword position, but it is not clear if we
+		     ;; want that.
+		     (let* ((keywords 
+			     (append (mapcar #'keyword-arg.keyword
+					     (arglist.keyword-args arglist))
+				     (remove-if-not #'keywordp (arglist.any-args arglist))))
+			    (keyword-name
+			     (tokenize-symbol keyword-string))
+			    (matching-keywords
+			     (find-matching-symbols-in-list keyword-name keywords
+							    #'compound-prefix-match))
+			    (converter (completion-output-symbol-converter keyword-string))
+			    (strings
+			     (mapcar converter
+				     (mapcar #'symbol-name matching-keywords)))
+			    (completion-set
+			     (format-completion-set strings nil "")))
+		       (list completion-set
+			     (longest-compound-prefix completion-set))))))))
+        (mapc #'unintern-in-home-package newly-interned-symbols)))))
+           
+
+(defun arglist-to-string (arglist package &key print-right-margin highlight)
+  (decoded-arglist-to-string (decode-arglist arglist)
+                             :package package
+                             :print-right-margin print-right-margin
+                             :highlight highlight))
+
+(defun test-print-arglist ()
+  (flet ((test (list string)
+           (let* ((p (find-package :swank))
+                  (actual (arglist-to-string list p)))
+             (unless (string= actual string)
+               (warn "Test failed: ~S => ~S~%  Expected: ~S" 
+                     list actual string)))))
+    (test '(function cons) "(function cons)")
+    (test '(quote cons) "(quote cons)")
+    (test '(&key (function #'+)) "(&key (function #'+))")
+    (test '(&whole x y z) "(y z)")
+    (test '(x &aux y z) "(x)")
+    (test '(x &environment env y) "(x y)")
+    (test '(&key ((function f))) "(&key ((function f)))")
+    (test '(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)
+	  "(eval-when (&any :compile-toplevel :load-toplevel :execute) &body body)")
+    (test '(declare (optimize &any (speed 1) (safety 1)))
+	  "(declare (optimize &any (speed 1) (safety 1)))")
+    ))
+
+(test-print-arglist)
+
+(provide :swank-arglists)

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-asdf.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,63 @@
+;;; swank-asdf.el -- ASDF support
+;;
+;; Authors: Daniel Barlow  <dan at telent.net>
+;;          Marco Baringer <mb at bese.it>
+;;          Edi Weitz <edi at agharta.de>
+;;          and others 
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+(defslimefun operate-on-system-for-emacs (system-name operation &rest keywords)
+  "Compile and load SYSTEM using ASDF.
+Record compiler notes signalled as `compiler-condition's."
+  (swank-compiler 
+   (lambda ()
+     (apply #'operate-on-system system-name operation keywords))))
+
+(defun operate-on-system (system-name operation-name &rest keyword-args)
+  "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
+The KEYWORD-ARGS are passed on to the operation.
+Example:
+\(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
+  (with-compilation-hooks ()
+    (let ((operation (find-symbol operation-name :asdf)))
+      (when (null operation)
+        (error "Couldn't find ASDF operation ~S" operation-name))
+      (apply #'asdf:operate operation system-name keyword-args))))
+
+(defun asdf-central-registry ()
+  asdf:*central-registry*)
+
+(defslimefun list-all-systems-in-central-registry ()
+  "Returns a list of all systems in ASDF's central registry."
+  (mapcar #'pathname-name
+          (delete-duplicates
+           (loop for dir in (asdf-central-registry)
+                 for defaults = (eval dir)
+                 when defaults
+                   nconc (mapcar #'file-namestring
+                                   (directory
+                                     (make-pathname :defaults defaults
+                                          :version :newest
+                                          :type "asd"
+                                          :name :wild
+                                          :case :local))))
+           :test #'string=)))
+
+(defslimefun list-all-systems-known-to-asdf ()
+  "Returns a list of all systems ASDF knows already."
+  ;; ugh, yeah, it's unexported - but do we really expect this to
+  ;; change anytime soon?
+  (loop for name being the hash-keys of asdf::*defined-systems*
+        collect name))
+
+(defslimefun list-asdf-systems ()
+  "Returns the systems in ASDF's central registry and those which ASDF
+already knows."
+  (nunion (list-all-systems-known-to-asdf)
+          (list-all-systems-in-central-registry)
+          :test #'string=))
+
+(provide :swank-asdf)

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-c-p-c.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,279 @@
+;;; swank-c-p-c.lisp -- ILISP style Compound Prefix Completion
+;;
+;; Author: Luke Gorrie  <luke at synap.se>
+;;         Edi Weitz  <edi at agharta.de>
+;;         Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de> 
+;;         Tobias C. Rittweiler <tcr at freebits.de>
+;;         and others
+;;
+;; License: Public Domain
+;;
+
+
+(in-package :swank)
+
+(defslimefun completions (string default-package-name)
+  "Return a list of completions for a symbol designator STRING.  
+
+The result is the list (COMPLETION-SET COMPLETED-PREFIX), where
+COMPLETION-SET is the list of all matching completions, and
+COMPLETED-PREFIX is the best (partial) completion of the input
+string.
+
+Simple compound matching is supported on a per-hyphen basis:
+
+  (completions \"m-v-\" \"COMMON-LISP\")
+    ==> ((\"multiple-value-bind\" \"multiple-value-call\" 
+          \"multiple-value-list\" \"multiple-value-prog1\" 
+          \"multiple-value-setq\" \"multiple-values-limit\")
+         \"multiple-value\")
+
+\(For more advanced compound matching, see FUZZY-COMPLETIONS.)
+
+If STRING is package qualified the result list will also be
+qualified.  If string is non-qualified the result strings are
+also not qualified and are considered relative to
+DEFAULT-PACKAGE-NAME.
+
+The way symbols are matched depends on the symbol designator's
+format. The cases are as follows:
+  FOO      - Symbols with matching prefix and accessible in the buffer package.
+  PKG:FOO  - Symbols with matching prefix and external in package PKG.
+  PKG::FOO - Symbols with matching prefix and accessible in package PKG.
+"
+  (let ((completion-set (completion-set string default-package-name
+                                        #'compound-prefix-match)))
+    (when completion-set
+      (list completion-set (longest-compound-prefix completion-set)))))
+
+;;;;; Find completion set
+
+(defun completion-set (string default-package-name matchp)
+  "Return the set of completion-candidates as strings."
+  (multiple-value-bind (name package-name package internal-p)
+      (parse-completion-arguments string default-package-name)
+    (let* ((symbols (mapcar (completion-output-symbol-converter name)
+                            (and package
+                                 (mapcar #'symbol-name
+                                         (find-matching-symbols name
+                                                                package
+                                                                (and (not internal-p)
+                                                                     package-name)
+                                                                matchp)))))
+           (packs (mapcar (completion-output-package-converter name)
+                          (and (not package-name)
+                               (find-matching-packages name matchp)))))
+      (format-completion-set (nconc symbols packs) internal-p package-name))))
+
+(defun find-matching-symbols (string package external test)
+  "Return a list of symbols in PACKAGE matching STRING.
+TEST is called with two strings.  If EXTERNAL is true, only external
+symbols are returned."
+  (let ((completions '())
+        (converter (completion-output-symbol-converter string)))
+    (flet ((symbol-matches-p (symbol)
+             (and (or (not external)
+                      (symbol-external-p symbol package))
+                  (funcall test string
+                           (funcall converter (symbol-name symbol))))))
+      (do-symbols* (symbol package) 
+        (when (symbol-matches-p symbol)
+          (push symbol completions))))
+    completions))
+
+(defun find-matching-symbols-in-list (string list test)
+  "Return a list of symbols in LIST matching STRING.
+TEST is called with two strings."
+  (let ((completions '())
+        (converter (completion-output-symbol-converter string)))
+    (flet ((symbol-matches-p (symbol)
+             (funcall test string
+                      (funcall converter (symbol-name symbol)))))
+      (dolist (symbol list) 
+        (when (symbol-matches-p symbol)
+          (push symbol completions))))
+    (remove-duplicates completions)))
+
+(defun find-matching-packages (name matcher)
+  "Return a list of package names matching NAME with MATCHER.
+MATCHER is a two-argument predicate."
+  (let ((to-match (string-upcase name)))
+    (remove-if-not (lambda (x) (funcall matcher to-match x))
+                   (mapcar (lambda (pkgname)
+                             (concatenate 'string pkgname ":"))
+                           (loop for package in (list-all-packages)
+                                 collect (package-name package)
+                                 append (package-nicknames package))))))
+
+
+;; PARSE-COMPLETION-ARGUMENTS return table:
+;; 
+;;  user behaviour |  NAME  | PACKAGE-NAME | PACKAGE 
+;; ----------------+--------+--------------+-----------------------------------
+;; asdf     [tab]  | "asdf" |     NIL      | #<PACKAGE "DEFAULT-PACKAGE-NAME">
+;;                 |        |              |      or *BUFFER-PACKAGE*
+;; asdf:    [tab]  |   ""   |    "asdf"    | #<PACKAGE "ASDF">
+;;                 |        |              |
+;; asdf:foo [tab]  | "foo"  |    "asdf"    | #<PACKAGE "ASDF">
+;;                 |        |              |
+;; as:fo    [tab]  |  "fo"  |     "as"     | NIL              
+;;                 |        |              |
+;; :        [tab]  |   ""   |      ""      | #<PACKAGE "KEYWORD">
+;;                 |        |              |
+;; :foo     [tab]  | "foo"  |      ""      | #<PACKAGE "KEYWORD">
+;;
+(defun parse-completion-arguments (string default-package-name)
+  "Parse STRING as a symbol designator.
+Return these values:
+ SYMBOL-NAME
+ PACKAGE-NAME, or nil if the designator does not include an explicit package.
+ PACKAGE, generally the package to complete in. (However, if PACKAGE-NAME is 
+          NIL, return the respective package of DEFAULT-PACKAGE-NAME instead; 
+          if PACKAGE is non-NIL but a package cannot be found under that name,
+          return NIL.)
+ INTERNAL-P, if the symbol is qualified with `::'."
+  (multiple-value-bind (name package-name internal-p)
+      (tokenize-symbol string)
+    (if package-name
+	(let ((package (guess-package (if (equal package-name "")
+					  "KEYWORD"
+					  package-name))))
+	  (values name package-name package internal-p))
+	(let ((package (guess-package default-package-name)))
+	  (values name package-name (or package *buffer-package*) internal-p))
+	)))
+
+
+
+(defun completion-output-case-converter (input &optional with-escaping-p)
+  "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case."
+  (ecase (readtable-case *readtable*)
+    (:upcase (cond ((or with-escaping-p
+                        (not (some #'lower-case-p input)))
+                    #'identity)
+                   (t #'string-downcase)))
+    (:invert (lambda (output)
+               (multiple-value-bind (lower upper) (determine-case output)
+                 (cond ((and lower upper) output)
+                       (lower (string-upcase output))
+                       (upper (string-downcase output))
+                       (t output)))))
+    (:downcase (cond ((or with-escaping-p
+                          (not (some #'upper-case-p input)))
+                      #'identity)
+                     (t #'string-upcase)))
+    (:preserve #'identity)))
+
+(defun completion-output-package-converter (input)
+  "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case."
+  (completion-output-case-converter input))
+
+(defun completion-output-symbol-converter (input)
+  "Return a function to convert strings for the completion output.
+INPUT is used to guess the preferred case. Escape symbols when needed."
+  (let ((case-converter (completion-output-case-converter input))
+        (case-converter-with-escaping (completion-output-case-converter input t)))
+    (lambda (str)
+      (if (or (multiple-value-bind (lowercase uppercase)
+                  (determine-case str)
+                ;; In these readtable cases, symbols with letters from
+                ;; the wrong case need escaping
+                (case (readtable-case *readtable*)
+                  (:upcase   lowercase)
+                  (:downcase uppercase)
+                  (t         nil)))
+              (some (lambda (el)
+                      (or (member el '(#\: #\Space #\Newline #\Tab))
+                          (multiple-value-bind (macrofun nonterminating)
+                              (get-macro-character el)
+                            (and macrofun
+                                 (not nonterminating)))))
+                    str))
+          (concatenate 'string "|" (funcall case-converter-with-escaping str) "|")
+          (funcall case-converter str)))))
+
+
+(defun determine-case (string)
+  "Return two booleans LOWER and UPPER indicating whether STRING
+contains lower or upper case characters."
+  (values (some #'lower-case-p string)
+          (some #'upper-case-p string)))
+
+
+;;;;; Compound-prefix matching
+
+(defun make-compound-prefix-matcher (delimeter &key (test #'char=))
+  "Returns a matching function that takes a `prefix' and a
+`target' string and which returns T if `prefix' is a
+compound-prefix of `target', and otherwise NIL.
+
+Viewing each of `prefix' and `target' as a series of substrings
+delimited by DELIMETER, if each substring of `prefix' is a prefix
+of the corresponding substring in `target' then we call `prefix'
+a compound-prefix of `target'."
+  (lambda (prefix target)
+    (declare (type simple-string prefix target))
+    (loop for ch across prefix
+          with tpos = 0
+          always (and (< tpos (length target))
+                      (if (char= ch delimeter)
+                          (setf tpos (position #\- target :start tpos))
+                          (funcall test ch (aref target tpos))))
+          do (incf tpos))))
+
+(defun compound-prefix-match (prefix target)
+  "Examples:
+\(compound-prefix-match \"foo\" \"foobar\") => t
+\(compound-prefix-match \"m--b\" \"multiple-value-bind\") => t
+\(compound-prefix-match \"m-v-c\" \"multiple-value-bind\") => NIL
+"
+  (funcall (make-compound-prefix-matcher #\-) prefix target))
+
+
+;;;;; Extending the input string by completion
+
+(defun longest-compound-prefix (completions &optional (delimeter #\-))
+  "Return the longest compound _prefix_ for all COMPLETIONS."
+  (flet ((tokenizer (string) (tokenize-completion string delimeter)))
+    (untokenize-completion
+     (loop for token-list in (transpose-lists (mapcar #'tokenizer completions))
+           if (notevery #'string= token-list (rest token-list))
+             collect (longest-common-prefix token-list) ; Note that we possibly collect
+             and do (loop-finish)                       ;  the "" here as well, so that
+           else collect (first token-list)))))          ;  UNTOKENIZE-COMPLETION will
+                                                        ;  append a hyphen for us.
+(defun tokenize-completion (string delimeter)
+  "Return all substrings of STRING delimited by DELIMETER."
+  (loop with end
+        for start = 0 then (1+ end)
+        until (> start (length string))
+        do (setq end (or (position delimeter string :start start) (length string)))
+        collect (subseq string start end)))
+
+(defun untokenize-completion (tokens)
+  (format nil "~{~A~^-~}" tokens))
+
+(defun transpose-lists (lists)
+  "Turn a list-of-lists on its side.
+If the rows are of unequal length, truncate uniformly to the shortest.
+
+For example:
+\(transpose-lists '((ONE TWO THREE) (1 2)))
+  => ((ONE 1) (TWO 2))"
+  (cond ((null lists) '())
+        ((some #'null lists) '())
+        (t (cons (mapcar #'car lists)
+                 (transpose-lists (mapcar #'cdr lists))))))
+
+
+;;;; Completion for character names
+
+(defslimefun completions-for-character (prefix)
+  (let* ((matcher (make-compound-prefix-matcher #\_ :test #'char-equal))
+         (completion-set (character-completion-set prefix matcher))
+         (completions (sort completion-set #'string<)))
+    (list completions (longest-compound-prefix completions #\_))))
+
+(provide :swank-c-p-c)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,737 @@
+;;; swank-fancy-inspector.lisp --- Fancy inspector for CLOS objects
+;;
+;; Author: Marco Baringer <mb at bese.it> and others
+;; License: Public Domain
+;;
+
+(in-package :swank)
+
+;; Subclass `backend-inspector' so that backend specific methods are
+;; also considered.
+(defclass fancy-inspector (backend-inspector) ())
+
+(defmethod inspect-for-emacs ((symbol symbol) (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (let ((package (symbol-package symbol)))
+    (multiple-value-bind (_symbol status) 
+	(and package (find-symbol (string symbol) package))
+      (declare (ignore _symbol))
+      (values 
+       "A symbol."
+       (append
+	(label-value-line "Its name is" (symbol-name symbol))
+	;;
+	;; Value 
+	(cond ((boundp symbol)
+               (label-value-line (if (constantp symbol)
+                                     "It is a constant of value"
+                                     "It is a global variable bound to")
+                                 (symbol-value symbol)))
+	      (t '("It is unbound." (:newline))))
+	(docstring-ispec "Documentation" symbol 'variable)
+	(multiple-value-bind (expansion definedp) (macroexpand symbol)
+	  (if definedp 
+	      (label-value-line "It is a symbol macro with expansion" 
+				expansion)))
+	;;
+	;; Function
+	(if (fboundp symbol)
+	    (append (if (macro-function symbol)
+			`("It a macro with macro-function: "
+			  (:value ,(macro-function symbol)))
+			`("It is a function: " 
+			  (:value ,(symbol-function symbol))))
+		    `(" " (:action "[make funbound]"
+				   ,(lambda () (fmakunbound symbol))))
+		    `((:newline)))
+	    `("It has no function value." (:newline)))
+	(docstring-ispec "Function Documentation" symbol 'function)
+	(if (compiler-macro-function symbol)
+	    (label-value-line "It also names the compiler macro"
+			      (compiler-macro-function symbol)))
+	(docstring-ispec "Compiler Macro Documentation" 
+			 symbol 'compiler-macro)
+	;;
+	;; Package
+        (if package
+            `("It is " ,(string-downcase (string status)) 
+                       " to the package: "
+                       (:value ,package ,(package-name package))
+                       ,@(if (eq :internal status) 
+                             `(" "
+                               (:action "[export it]"
+                                        ,(lambda () (export symbol package)))))
+                       " "
+                       (:action "[unintern it]"
+                                ,(lambda () (unintern symbol package)))
+                       (:newline))
+            '("It is a non-interned symbol." (:newline)))
+	;;
+	;; Plist
+	(label-value-line "Property list" (symbol-plist symbol))
+	;; 
+	;; Class
+	(if (find-class symbol nil)
+	    `("It names the class " 
+	      (:value ,(find-class symbol) ,(string symbol))
+              " "
+	      (:action "[remove]"
+		       ,(lambda () (setf (find-class symbol) nil)))
+	      (:newline)))
+	;;
+	;; More package
+	(if (find-package symbol)
+	    (label-value-line "It names the package" (find-package symbol)))
+	)))))
+
+(defun docstring-ispec (label object kind)
+  "Return a inspector spec if OBJECT has a docstring of of kind KIND."
+  (let ((docstring (documentation object kind)))
+    (cond ((not docstring) nil)
+	  ((< (+ (length label) (length docstring))
+	      75)
+	   (list label ": " docstring '(:newline)))
+	  (t 
+	   (list label ": " '(:newline) "  " docstring '(:newline))))))
+
+(defmethod inspect-for-emacs ((f function) (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A function."
+	  (append 
+	   (label-value-line "Name" (function-name f))
+	   `("Its argument list is: " 
+	     ,(inspector-princ (arglist f)) (:newline))
+	   (docstring-ispec "Documentation" f t)
+	   (if (function-lambda-expression f)
+	       (label-value-line "Lambda Expression"
+				 (function-lambda-expression f))))))
+
+(defun method-specializers-for-inspect (method)
+  "Return a \"pretty\" list of the method's specializers. Normal
+  specializers are replaced by the name of the class, eql
+  specializers are replaced by `(eql ,object)."
+  (mapcar (lambda (spec)
+            (typecase spec
+              (swank-mop:eql-specializer
+               `(eql ,(swank-mop:eql-specializer-object spec)))
+              (t (swank-mop:class-name spec))))
+          (swank-mop:method-specializers method)))
+
+(defun method-for-inspect-value (method)
+  "Returns a \"pretty\" list describing METHOD. The first element
+  of the list is the name of generic-function method is
+  specialiazed on, the second element is the method qualifiers,
+  the rest of the list is the method's specialiazers (as per
+  method-specializers-for-inspect)."
+  (append (list (swank-mop:generic-function-name
+		 (swank-mop:method-generic-function method)))
+	  (swank-mop:method-qualifiers method)
+	  (method-specializers-for-inspect method)))
+
+(defmethod inspect-for-emacs ((object standard-object) 
+			      (inspector fancy-inspector))
+  (let ((class (class-of object)))
+    (values "An object."
+            `("Class: " (:value ,class) (:newline)
+              ,@(all-slots-for-inspector object inspector)))))
+
+(defvar *gf-method-getter* 'methods-by-applicability
+  "This function is called to get the methods of a generic function.
+The default returns the method sorted by applicability.
+See `methods-by-applicability'.")
+
+(defun specializer< (specializer1 specializer2)
+  "Return true if SPECIALIZER1 is more specific than SPECIALIZER2."
+  (let ((s1 specializer1) (s2 specializer2) )
+    (cond ((typep s1 'swank-mop:eql-specializer)
+	   (not (typep s2 'swank-mop:eql-specializer)))
+	  (t
+	   (flet ((cpl (class)
+		    (and (swank-mop:class-finalized-p class)
+			 (swank-mop:class-precedence-list class))))
+	     (member s2 (cpl s1)))))))
+
+(defun methods-by-applicability (gf)
+  "Return methods ordered by most specific argument types.
+
+`method-specializer<' is used for sorting."
+  ;; FIXME: argument-precedence-order and qualifiers are ignored.  
+  (labels ((method< (meth1 meth2)
+             (loop for s1 in (swank-mop:method-specializers meth1)
+                   for s2 in (swank-mop:method-specializers meth2)
+                   do (cond ((specializer< s2 s1) (return nil))
+                            ((specializer< s1 s2) (return t))))))
+    (stable-sort (copy-seq (swank-mop:generic-function-methods gf)) #'method<)))
+
+(defun abbrev-doc (doc &optional (maxlen 80))
+  "Return the first sentence of DOC, but not more than MAXLAN characters."
+  (subseq doc 0 (min (1+ (or (position #\. doc) (1- maxlen)))
+		     maxlen
+		     (length doc))))
+
+(defgeneric inspect-slot-for-emacs (class object slot)
+  (:method (class object slot)
+           (let ((slot-name (swank-mop:slot-definition-name slot))
+                 (boundp (swank-mop:slot-boundp-using-class class object slot)))
+             `(,@(if boundp
+                     `((:value ,(swank-mop:slot-value-using-class class object slot)))
+                     `("#<unbound>"))
+               " "
+               (:action "[set value]"
+                ,(lambda () (with-simple-restart
+                                (abort "Abort setting slot ~S" slot-name)
+                              (let ((value-string (eval-in-emacs
+                                                   `(condition-case c
+                                                     (slime-read-object
+                                                      ,(format nil "Set slot ~S to (evaluated) : " slot-name))
+                                                     (quit nil)))))
+                                (when (and value-string
+                                           (not (string= value-string "")))
+                                  (setf (swank-mop:slot-value-using-class class object slot)
+                                        (eval (read-from-string value-string))))))))
+               ,@(when boundp
+                   `(" " (:action "[make unbound]"
+                          ,(lambda () (swank-mop:slot-makunbound-using-class class object slot)))))))))
+
+(defgeneric all-slots-for-inspector (object inspector)
+  (:method ((object standard-object) inspector)
+    (declare (ignore inspector))
+    (append '("--------------------" (:newline)
+              "All Slots:" (:newline))
+            (let* ((class (class-of object))
+                   (direct-slots (swank-mop:class-direct-slots class))
+                   (effective-slots (sort (copy-seq (swank-mop:class-slots class))
+                                          #'string< :key #'swank-mop:slot-definition-name))
+                   (slot-presentations (loop for effective-slot :in effective-slots
+                                             collect (inspect-slot-for-emacs
+                                                      class object effective-slot)))
+                   (longest-slot-name-length
+                    (loop for slot :in effective-slots
+                          maximize (length (symbol-name
+                                            (swank-mop:slot-definition-name slot))))))
+              (loop
+                  for effective-slot :in effective-slots
+                  for slot-presentation :in slot-presentations
+                  for direct-slot = (find (swank-mop:slot-definition-name effective-slot)
+                                          direct-slots :key #'swank-mop:slot-definition-name)
+                  for slot-name = (inspector-princ
+                                   (swank-mop:slot-definition-name effective-slot))
+                  for padding-length = (- longest-slot-name-length
+                                          (length (symbol-name
+                                                   (swank-mop:slot-definition-name
+                                                    effective-slot))))
+                  collect `(:value ,(if direct-slot
+                                        (list direct-slot effective-slot)
+                                        effective-slot)
+                            ,slot-name)
+                  collect (make-array padding-length
+                                      :element-type 'character
+                                      :initial-element #\Space)
+                  collect " = "
+                  append slot-presentation
+                  collect '(:newline))))))
+
+(defmethod inspect-for-emacs ((gf standard-generic-function) 
+                              (inspector fancy-inspector)) 
+  (flet ((lv (label value) (label-value-line label value)))
+    (values 
+     "A generic function."
+     (append 
+      (lv "Name" (swank-mop:generic-function-name gf))
+      (lv "Arguments" (swank-mop:generic-function-lambda-list gf))
+      (docstring-ispec "Documentation" gf t)
+      (lv "Method class" (swank-mop:generic-function-method-class gf))
+      (lv "Method combination" 
+	  (swank-mop:generic-function-method-combination gf))
+      `("Methods: " (:newline))
+      (loop for method in (funcall *gf-method-getter* gf) append
+	    `((:value ,method ,(inspector-princ
+			       ;; drop the name of the GF
+			       (cdr (method-for-inspect-value method))))
+              " "
+	      (:action "[remove method]" 
+                       ,(let ((m method)) ; LOOP reassigns method
+                          (lambda () 
+                            (remove-method gf m))))
+	      (:newline)))
+      `((:newline))
+      (all-slots-for-inspector gf inspector)))))
+
+(defmethod inspect-for-emacs ((method standard-method) 
+                              (inspector fancy-inspector))
+  (values "A method." 
+          `("Method defined on the generic function " 
+	    (:value ,(swank-mop:method-generic-function method)
+		    ,(inspector-princ
+		      (swank-mop:generic-function-name
+		       (swank-mop:method-generic-function method))))
+            (:newline)
+	    ,@(docstring-ispec "Documentation" method t)
+            "Lambda List: " (:value ,(swank-mop:method-lambda-list method))
+            (:newline)
+            "Specializers: " (:value ,(swank-mop:method-specializers method)
+                                     ,(inspector-princ (method-specializers-for-inspect method)))
+            (:newline)
+            "Qualifiers: " (:value ,(swank-mop:method-qualifiers method))
+            (:newline)
+            "Method function: " (:value ,(swank-mop:method-function method))
+            (:newline)
+            ,@(all-slots-for-inspector method inspector))))
+
+(defmethod inspect-for-emacs ((class standard-class) 
+                              (inspector fancy-inspector))
+  (values "A class."
+          `("Name: " (:value ,(class-name class))
+            (:newline)
+            "Super classes: "
+            ,@(common-seperated-spec (swank-mop:class-direct-superclasses class))
+            (:newline)
+            "Direct Slots: "
+            ,@(common-seperated-spec
+               (swank-mop:class-direct-slots class)
+               (lambda (slot)
+                 `(:value ,slot ,(inspector-princ (swank-mop:slot-definition-name slot)))))
+            (:newline)
+            "Effective Slots: "
+            ,@(if (swank-mop:class-finalized-p class)
+                  (common-seperated-spec
+                   (swank-mop:class-slots class)
+                   (lambda (slot)
+                     `(:value ,slot ,(inspector-princ
+                                      (swank-mop:slot-definition-name slot)))))
+                  '("#<N/A (class not finalized)>"))
+            (:newline)
+            ,@(let ((doc (documentation class t)))
+                (when doc
+                  `("Documentation:" (:newline) ,(inspector-princ doc) (:newline))))
+            "Sub classes: "
+            ,@(common-seperated-spec (swank-mop:class-direct-subclasses class)
+                                     (lambda (sub)
+                                       `(:value ,sub ,(inspector-princ (class-name sub)))))
+            (:newline)
+            "Precedence List: "
+            ,@(if (swank-mop:class-finalized-p class)
+                  (common-seperated-spec (swank-mop:class-precedence-list class)
+                                         (lambda (class)
+                                           `(:value ,class ,(inspector-princ (class-name class)))))
+                  '("#<N/A (class not finalized)>"))
+            (:newline)
+            ,@(when (swank-mop:specializer-direct-methods class)
+               `("It is used as a direct specializer in the following methods:" (:newline)
+                 ,@(loop
+                      for method in (sort (copy-seq (swank-mop:specializer-direct-methods class))
+                                          #'string< :key (lambda (x)
+                                                           (symbol-name
+                                                            (let ((name (swank-mop::generic-function-name
+                                                                         (swank-mop::method-generic-function x))))
+                                                              (if (symbolp name) name (second name))))))
+                      collect "  "
+                      collect `(:value ,method ,(inspector-princ (method-for-inspect-value method)))
+                      collect '(:newline)
+                      if (documentation method t)
+                      collect "    Documentation: " and
+                      collect (abbrev-doc (documentation method t)) and
+                      collect '(:newline))))
+            "Prototype: " ,(if (swank-mop:class-finalized-p class)
+                               `(:value ,(swank-mop:class-prototype class))
+                               '"#<N/A (class not finalized)>")
+            (:newline)
+            ,@(all-slots-for-inspector class inspector))))
+
+(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) 
+                              (inspector fancy-inspector))
+  (values "A slot."
+          `("Name: " (:value ,(swank-mop:slot-definition-name slot))
+            (:newline)
+            ,@(when (swank-mop:slot-definition-documentation slot)
+                `("Documentation:"  (:newline)
+                  (:value ,(swank-mop:slot-definition-documentation slot))
+                  (:newline)))
+            "Init args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline)
+            "Init form: "  ,(if (swank-mop:slot-definition-initfunction slot)
+                             `(:value ,(swank-mop:slot-definition-initform slot))
+                             "#<unspecified>") (:newline)
+            "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))            
+            (:newline)
+            ,@(all-slots-for-inspector slot inspector))))
+
+
+;; Wrapper structure over the list of symbols of a package that should
+;; be displayed with their respective classification flags. This is
+;; because we need a unique type to dispatch on in INSPECT-FOR-EMACS.
+;; Used by the Inspector for packages.
+(defstruct (%package-symbols-container (:conc-name   %container.)
+                                       (:constructor %%make-package-symbols-container))
+  title          ;; A string; the title of the inspector page in Emacs.   
+  description    ;; A list of renderable objects; used as description.
+  symbols        ;; A list of symbols. Supposed to be sorted alphabetically.
+  grouping-kind  ;; Either :SYMBOL or :CLASSIFICATION. Cf. MAKE-SYMBOLS-LISTING.
+  )
+
+(defun %make-package-symbols-container (&key title description symbols)
+  (%%make-package-symbols-container :title title :description description
+                                    :symbols symbols :grouping-kind :symbol))
+
+(defgeneric make-symbols-listing (grouping-kind symbols))
+
+(defmethod make-symbols-listing ((grouping-kind (eql :symbol)) symbols)
+  "Returns an object renderable by Emacs' inspector side that
+alphabetically lists all the symbols in SYMBOLS together with a
+concise string representation of what each symbol
+represents (cf. CLASSIFY-SYMBOL & Fuzzy Completion.)"
+  (let ((max-length (loop for s in symbols maximizing (length (symbol-name s))))
+        (distance 10)) ; empty distance between name and classification
+    (flet ((string-representations (symbol)
+             (let* ((name (symbol-name symbol))
+                    (length (length name))
+                    (padding (- max-length length))                    
+                    (classification (classify-symbol symbol)))
+               (values
+                (concatenate 'string
+                             name
+                             (make-string (+ padding distance) :initial-element #\Space))
+                (symbol-classification->string classification)))))
+      `(""                           ; 8 is (length "Symbols:")
+        "Symbols:" ,(make-string (+ -8 max-length distance) :initial-element #\Space) "Flags:"
+        (:newline)
+        ,(concatenate 'string        ; underlining dashes
+                      (make-string (+ max-length distance -1) :initial-element #\-)
+                      " "
+                      (let* ((dummy (classify-symbol (gensym)))
+                             (dummy (symbol-classification->string dummy))
+                             (classification-length (length dummy)))
+                        (make-string classification-length :initial-element #\-)))
+        (:newline)          
+        ,@(loop for symbol in symbols appending
+               (multiple-value-bind (symbol-string classification-string)
+                   (string-representations symbol)
+                 `((:value ,symbol ,symbol-string) ,classification-string
+                   (:newline)
+                   )))))))
+
+(defmethod make-symbols-listing ((grouping-kind (eql :classification)) symbols)
+  "For each possible classification (cf. CLASSIFY-SYMBOL), group
+all the symbols in SYMBOLS to all of their respective
+classifications. (If a symbol is, for instance, boundp and a
+generic-function, it'll appear both below the BOUNDP group and
+the GENERIC-FUNCTION group.) As macros and special-operators are
+specified to be FBOUNDP, there is no general FBOUNDP group,
+instead there are the three explicit FUNCTION, MACRO and
+SPECIAL-OPERATOR groups."
+  (let ((table (make-hash-table :test #'eq)))
+    (flet ((maybe-convert-fboundps (classifications)
+             ;; Convert an :FBOUNDP in CLASSIFICATIONS to :FUNCTION if possible.
+             (if (and (member :fboundp classifications)
+                      (not (member :macro classifications))
+                      (not (member :special-operator classifications)))
+                 (substitute :function :fboundp classifications)
+                 (remove :fboundp classifications))))
+      (loop for symbol in symbols do
+            (loop for classification in (maybe-convert-fboundps (classify-symbol symbol))
+                  ;; SYMBOLS are supposed to be sorted alphabetically;
+                  ;; this property is preserved here except for reversing.
+                  do (push symbol (gethash classification table)))))
+    (let* ((classifications (loop for k being each hash-key in table collect k))
+           (classifications (sort classifications #'string<)))
+      (loop for classification in classifications
+            for symbols = (gethash classification table)
+            appending`(,(symbol-name classification)
+                        (:newline)
+                        ,(make-string 64 :initial-element #\-)
+                        (:newline)
+                        ,@(mapcan #'(lambda (symbol)
+                                      (list `(:value ,symbol ,(symbol-name symbol)) '(:newline)))
+                                  (nreverse symbols)) ; restore alphabetic orderness.
+                        (:newline)
+                        )))))
+
+(defmethod inspect-for-emacs ((%container %package-symbols-container) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (with-struct (%container. title description symbols grouping-kind) %container
+    (values title
+            `(, at description
+              (:newline)
+              "  " ,(ecase grouping-kind
+                           (:symbol
+                            `(:action "[Group by classification]"
+                                      ,(lambda () (setf grouping-kind :classification))
+                                      :refreshp t))
+                           (:classification
+                            `(:action "[Group by symbol]"
+                                      ,(lambda () (setf grouping-kind :symbol))
+                                      :refreshp t)))
+              (:newline) (:newline)
+              ,@(make-symbols-listing grouping-kind symbols)))))
+
+
+(defmethod inspect-for-emacs ((package package) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (let ((package-name         (package-name package))
+        (package-nicknames    (package-nicknames package))
+        (package-use-list     (package-use-list package))
+        (package-used-by-list (package-used-by-list package))
+        (shadowed-symbols     (package-shadowing-symbols package))
+        (present-symbols      '()) (present-symbols-length  0)
+        (internal-symbols     '()) (internal-symbols-length 0)
+        (external-symbols     '()) (external-symbols-length 0))
+
+    (do-symbols* (sym package)
+      (let ((status (symbol-status sym package)))
+        (when (not (eq status :inherited))
+          (push sym present-symbols) (incf present-symbols-length)
+          (if (eq status :internal)
+              (progn (push sym internal-symbols) (incf internal-symbols-length))                
+              (progn (push sym external-symbols) (incf external-symbols-length))))))
+    
+    (setf package-nicknames    (sort (copy-list package-nicknames)    #'string<)
+          package-use-list     (sort (copy-list package-use-list)     #'string< :key #'package-name)
+          package-used-by-list (sort (copy-list package-used-by-list) #'string< :key #'package-name)
+          shadowed-symbols     (sort (copy-list shadowed-symbols)     #'string<))
+    
+    (setf present-symbols      (sort present-symbols  #'string<)  ; SORT + STRING-LESSP
+          internal-symbols     (sort internal-symbols #'string<)  ; conses on at least
+          external-symbols     (sort external-symbols #'string<)) ; SBCL 0.9.18.
+
+    
+    (values
+     "A package."
+     `(""                               ; dummy to preserve indentation.
+       "Name: " (:value ,package-name) (:newline)
+                       
+       "Nick names: " ,@(common-seperated-spec package-nicknames) (:newline)
+              
+       ,@(when (documentation package t)
+               `("Documentation:" (:newline) ,(documentation package t) (:newline)))
+              
+       "Use list: " ,@(common-seperated-spec
+                       package-use-list
+                       (lambda (package)
+                         `(:value ,package ,(package-name package))))
+       (:newline)
+              
+       "Used by list: " ,@(common-seperated-spec
+                           package-used-by-list
+                           (lambda (package)
+                             `(:value ,package ,(package-name package))))
+       (:newline)
+
+       ,@     ; ,@(flet ((...)) ...) would break indentation in Emacs.
+       (flet ((display-link (type symbols length &key title description)
+                (if (null symbols)
+                    (format nil "0 ~A symbols." type)
+                    `(:value ,(%make-package-symbols-container :title title
+                                                               :description description
+                                                               :symbols symbols)
+                             ,(format nil "~D ~A symbol~P." length type length)))))
+         
+         `(,(display-link "present" present-symbols  present-symbols-length
+                          :title (format nil "All present symbols of package \"~A\"" package-name)
+                          :description
+                          '("A symbol is considered present in a package if it's" (:newline)
+                            "\"accessible in that package directly, rather than"  (:newline)
+                            "being inherited from another package.\""             (:newline)
+                            "(CLHS glossary entry for `present')"                 (:newline)))
+            
+            (:newline)
+            ,(display-link "external" external-symbols external-symbols-length
+                           :title (format nil "All external symbols of package \"~A\"" package-name)
+                           :description
+                           '("A symbol is considered external of a package if it's"  (:newline)
+                             "\"part of the `external interface' to the package and" (:newline)
+                             "[is] inherited by any other package that uses the"     (:newline)
+                             "package.\" (CLHS glossary entry of `external')"        (:newline)))
+            (:newline)
+            ,(display-link "internal" internal-symbols internal-symbols-length
+                           :title (format nil "All internal symbols of package \"~A\"" package-name)
+                           :description
+                           '("A symbol is considered internal of a package if it's"   (:newline)
+                             "present and not external---that is if the package is"   (:newline)
+                             "the home package of the symbol, or if the symbol has"   (:newline)
+                             "been explicitly imported into the package."             (:newline)
+                             (:newline)
+                             "Notice that inherited symbols will thus not be listed," (:newline)
+                             "which deliberately deviates from the CLHS glossary"     (:newline)
+                             "entry of `internal' because it's assumed to be more"    (:newline)
+                             "useful this way."                                       (:newline)))
+            (:newline)
+            ,(display-link "shadowed" shadowed-symbols (length shadowed-symbols)
+                           :title (format nil "All shadowed symbols of package \"~A\"" package-name)
+                           :description nil)))))))
+
+
+(defmethod inspect-for-emacs ((pathname pathname) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values (if (wild-pathname-p pathname)
+              "A wild pathname."
+              "A pathname.")
+          (append (label-value-line*
+                   ("Namestring" (namestring pathname))
+                   ("Host"       (pathname-host pathname))
+                   ("Device"     (pathname-device pathname))
+                   ("Directory"  (pathname-directory pathname))
+                   ("Name"       (pathname-name pathname))
+                   ("Type"       (pathname-type pathname))
+                   ("Version"    (pathname-version pathname)))
+                  (unless (or (wild-pathname-p pathname)
+                              (not (probe-file pathname)))
+                    (label-value-line "Truename" (truename pathname))))))
+
+(defmethod inspect-for-emacs ((pathname logical-pathname) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A logical pathname."
+          (append 
+           (label-value-line*
+            ("Namestring" (namestring pathname))
+            ("Physical pathname: " (translate-logical-pathname pathname)))
+           `("Host: " 
+             ,(pathname-host pathname)
+             " (" (:value ,(logical-pathname-translations
+                            (pathname-host pathname))) 
+             "other translations)"
+             (:newline))
+           (label-value-line*
+            ("Directory" (pathname-directory pathname))
+            ("Name" (pathname-name pathname))
+            ("Type" (pathname-type pathname))
+            ("Version" (pathname-version pathname))
+            ("Truename" (if (not (wild-pathname-p pathname))
+                            (probe-file pathname)))))))
+
+(defmethod inspect-for-emacs ((n number) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A number." `("Value: " ,(princ-to-string n))))
+
+(defun format-iso8601-time (time-value &optional include-timezone-p)
+    "Formats a universal time TIME-VALUE in ISO 8601 format, with
+    the time zone included if INCLUDE-TIMEZONE-P is non-NIL"    
+    ;; Taken from http://www.pvv.ntnu.no/~nsaa/ISO8601.html
+    ;; Thanks, Nikolai Sandved and Thomas Russ!
+    (flet ((format-iso8601-timezone (zone)
+             (if (zerop zone)
+                 "Z"
+                 (multiple-value-bind (h m) (truncate (abs zone) 1.0)
+                   ;; Tricky.  Sign of time zone is reversed in ISO 8601
+                   ;; relative to Common Lisp convention!
+                   (format nil "~:[+~;-~]~2,'0D:~2,'0D"
+                           (> zone 0) h (round (* 60 m)))))))
+    (multiple-value-bind (second minute hour day month year dow dst zone)
+      (decode-universal-time time-value)
+      (declare (ignore dow dst))
+      (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D~:[~*~;~A~]"
+              year month day hour minute second
+              include-timezone-p (format-iso8601-timezone zone)))))
+
+(defmethod inspect-for-emacs ((i integer) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A number."
+          (append
+           `(,(format nil "Value: ~D = #x~8,'0X = #o~O = #b~,,' ,8:B~@[ = ~E~]"
+                      i i i i (ignore-errors (coerce i 'float)))
+              (:newline))
+           (when (< -1 i char-code-limit)
+             (label-value-line "Code-char" (code-char i)))
+           (label-value-line "Integer-length" (integer-length i))           
+           (ignore-errors
+             (label-value-line "Universal-time" (format-iso8601-time i t))))))
+
+(defmethod inspect-for-emacs ((c complex) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A complex number."
+          (label-value-line* 
+           ("Real part" (realpart c))
+           ("Imaginary part" (imagpart c)))))
+
+(defmethod inspect-for-emacs ((r ratio) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A non-integer ratio."
+          (label-value-line*
+           ("Numerator" (numerator r))
+           ("Denominator" (denominator r))
+           ("As float" (float r)))))
+
+(defmethod inspect-for-emacs ((f float) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (values "A floating point number."
+          (cond
+            ((> f most-positive-long-float)
+             (list "Positive infinity."))
+            ((< f most-negative-long-float)
+             (list "Negative infinity."))
+            ((not (= f f))
+             (list "Not a Number."))
+            (t
+             (multiple-value-bind (significand exponent sign) (decode-float f)
+               (append 
+                `("Scientific: " ,(format nil "~E" f) (:newline)
+                                 "Decoded: " 
+                                 (:value ,sign) " * " 
+                                 (:value ,significand) " * " 
+                                 (:value ,(float-radix f)) "^" (:value ,exponent) (:newline))
+                (label-value-line "Digits" (float-digits f))
+                (label-value-line "Precision" (float-precision f))))))))
+
+(defmethod inspect-for-emacs ((stream file-stream) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (multiple-value-bind (title content)
+      (call-next-method)
+    (declare (ignore title))
+    (values "A file stream."
+            (append
+             `("Pathname: "
+               (:value ,(pathname stream))
+               (:newline) "  "
+               (:action "[visit file and show current position]"
+                        ,(let ((pathname (pathname stream))
+                               (position (file-position stream)))
+                           (lambda ()
+                             (ed-in-emacs `(,pathname :charpos ,position))))
+                        :refreshp nil)
+               (:newline))
+             content))))
+
+(defmethod inspect-for-emacs ((condition stream-error) 
+                              (inspector fancy-inspector))
+  (declare (ignore inspector))
+  (multiple-value-bind (title content)
+      (call-next-method)
+    (let ((stream (stream-error-stream condition)))
+      (if (typep stream 'file-stream)
+          (values "A stream error."
+                  (append
+                   `("Pathname: "
+                     (:value ,(pathname stream))
+                     (:newline) "  "
+                     (:action "[visit file and show current position]"
+                              ,(let ((pathname (pathname stream))
+                                     (position (file-position stream)))
+                                    (lambda ()
+                                      (ed-in-emacs `(,pathname :charpos ,position))))
+                              :refreshp nil)
+                     (:newline))
+                   content))
+          (values title content)))))
+
+(defvar *fancy-inpector-undo-list* nil)
+
+(defslimefun fancy-inspector-init ()
+  (let ((i *default-inspector*))
+    (push (lambda () (setq *default-inspector* i))
+	  *fancy-inpector-undo-list*))
+  (setq *default-inspector* (make-instance 'fancy-inspector))
+  t)
+
+(defslimefun fancy-inspector-unload ()
+  (loop while *fancy-inpector-undo-list* do
+	(funcall (pop *fancy-inpector-undo-list*))))
+
+(provide :swank-fancy-inspector)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,620 @@
+;;; swank-fuzzy.lisp --- fuzzy symbol completion
+;;
+;; Authors: Brian Downing <bdowning at lavos.net>
+;;          Tobias C. Rittweiler <tcr at freebits.de>
+;;          and others
+;;
+;; License: Public Domain
+;;
+
+
+(in-package :swank)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (swank-require :swank-c-p-c))
+
+;;; For nomenclature of the fuzzy completion section, please read
+;;; through the following docstring.
+
+(defslimefun fuzzy-completions (string default-package-name &key limit time-limit-in-msec)
+"Returns a list of two values:
+
+  An (optionally limited to LIMIT best results) list of fuzzy
+  completions for a symbol designator STRING. The list will be
+  sorted by score, most likely match first.
+
+  A flag that indicates whether or not TIME-LIMIT-IN-MSEC has
+  been exhausted during computation. If that parameter's value is
+  NIL or 0, no time limit is assumed.
+
+The main result is a list of completion objects, where a completion
+object is:
+
+    (COMPLETED-STRING SCORE (&rest CHUNKS) FLAGS)
+
+where a CHUNK is a description of a matched substring:
+
+    (OFFSET SUBSTRING)
+
+and FLAGS is a list of keywords describing properties of the 
+symbol (see CLASSIFY-SYMBOL).
+
+E.g., completing \"mvb\" in a package that uses COMMON-LISP would
+return something like:
+
+    ((\"multiple-value-bind\" 26.588236 ((0 \"m\") (9 \"v\") (15 \"b\"))
+     (:FBOUNDP :MACRO))
+     ...)
+
+If STRING is package qualified the result list will also be
+qualified.  If string is non-qualified the result strings are
+also not qualified and are considered relative to
+DEFAULT-PACKAGE-NAME.
+
+Which symbols are candidates for matching depends on the symbol
+designator's format. The cases are as follows:
+  FOO      - Symbols accessible in the buffer package.
+  PKG:FOO  - Symbols external in package PKG.
+  PKG::FOO - Symbols accessible in package PKG."
+  ;; For Emacs we allow both NIL and 0 as value of TIME-LIMIT-IN-MSEC
+  ;; to denote an infinite time limit. Internally, we only use NIL for
+  ;; that purpose, to be able to distinguish between "no time limit
+  ;; alltogether" and "current time limit already exhausted." So we've
+  ;; got to canonicalize its value at first:
+  (let* ((no-time-limit-p (or (not time-limit-in-msec) (zerop time-limit-in-msec)))
+         (time-limit (if no-time-limit-p nil time-limit-in-msec)))
+    (multiple-value-bind (completion-set interrupted-p)
+        (fuzzy-completion-set string default-package-name :limit limit
+                              :time-limit-in-msec time-limit)
+      ;; We may send this as elisp [] arrays to spare a coerce here,
+      ;; but then the network serialization were slower by handling arrays.
+      ;; Instead we limit the number of completions that is transferred
+      ;; (the limit is set from Emacs.)
+      (list (coerce completion-set 'list) interrupted-p))))
+
+
+;;; A Fuzzy Matching -- Not to be confused with a fuzzy completion
+;;; object that will be sent back to Emacs, as described above.
+
+(defstruct (fuzzy-matching (:conc-name   fuzzy-matching.)
+			   (:predicate   fuzzy-matching-p)
+			   (:constructor %make-fuzzy-matching))
+  symbol	    ; The symbol that has been found to match.
+  package-name	    ; The name of the package where SYMBOL was found in.
+                    ;  (This is not necessarily the same as the home-package
+                    ;   of SYMBOL, because the SYMBOL can be internal to
+                    ;   lots of packages; also think of package nicknames.)
+  score	            ; The higher the better SYMBOL is a match.
+  package-chunks    ; Chunks pertaining to the package identifier of SYMBOL.
+  symbol-chunks)    ; Chunks pertaining to SYMBOL's name.
+
+(defun make-fuzzy-matching (symbol package-name score package-chunks symbol-chunks)
+  (declare (inline %make-fuzzy-matching))
+  (%make-fuzzy-matching :symbol symbol :package-name package-name :score score
+			:package-chunks package-chunks
+			:symbol-chunks symbol-chunks))
+
+(defun %fuzzy-extract-matching-info (fuzzy-matching user-input-string)
+  (multiple-value-bind (_ user-package-name __ input-internal-p)
+      (parse-completion-arguments user-input-string nil)
+    (declare (ignore _ __))
+    (with-struct (fuzzy-matching. score symbol package-name package-chunks symbol-chunks)
+	fuzzy-matching
+      (let (symbol-name real-package-name internal-p)
+	(cond (symbol ; symbol fuzzy matching?
+	       (setf symbol-name (symbol-name symbol))
+	       (setf internal-p input-internal-p)
+	       (setf real-package-name (cond ((keywordp symbol)     "")
+					     ((not user-package-name) nil)
+					     (t package-name))))
+	      (t      ; package fuzzy matching?
+	       (setf symbol-name "")
+	       (setf real-package-name package-name)
+	       ;; If no explicit package name was given by the user
+	       ;; (e.g. input was "asdf"), we want to append only
+	       ;; one colon ":" to the package names.
+	       (setf internal-p (if user-package-name input-internal-p nil))))
+	(values symbol-name
+		real-package-name
+		(if user-package-name internal-p nil)
+		(completion-output-symbol-converter user-input-string)
+		(completion-output-package-converter user-input-string))))))
+
+(defun fuzzy-format-matching (fuzzy-matching user-input-string)
+  "Returns the completion (\"foo:bar\") that's represented by FUZZY-MATCHING."
+  (multiple-value-bind (symbol-name package-name internal-p symbol-converter package-converter)
+      (%fuzzy-extract-matching-info fuzzy-matching user-input-string)
+    (setq symbol-name  (and symbol-name  (funcall symbol-converter symbol-name)))
+    (setq package-name (and package-name (funcall package-converter package-name)))
+    (let ((result (untokenize-symbol package-name internal-p symbol-name)))
+      ;; We return the length of the possibly added prefix as second value.
+      (values result (search symbol-name result)))))
+
+(defun fuzzy-convert-matching-for-emacs (fuzzy-matching user-input-string)
+  "Converts a result from the fuzzy completion core into
+something that emacs is expecting.  Converts symbols to strings,
+fixes case issues, and adds information describing if the symbol
+is :bound, :fbound, a :class, a :macro, a :generic-function,
+a :special-operator, or a :package."
+  (with-struct (fuzzy-matching. symbol score package-chunks symbol-chunks) fuzzy-matching
+    (multiple-value-bind (name added-length)
+	(fuzzy-format-matching fuzzy-matching user-input-string)
+      (list name
+	    score
+	    (append package-chunks
+		    (mapcar #'(lambda (chunk)
+				;; Fix up chunk positions to account for possible
+				;; added package identifier.
+				(let ((offset (first chunk)) (string (second chunk)))
+				  (list (+ added-length offset) string))) 
+			    symbol-chunks))
+	    (classify-symbol symbol)))))
+
+(defun fuzzy-completion-set (string default-package-name &key limit time-limit-in-msec)
+  "Returns two values: an array of completion objects, sorted by
+their score, that is how well they are a match for STRING
+according to the fuzzy completion algorithm.  If LIMIT is set,
+only the top LIMIT results will be returned. Additionally, a flag
+is returned that indicates whether or not TIME-LIMIT-IN-MSEC was
+exhausted."
+  (check-type limit (or null (integer 0 #.(1- most-positive-fixnum))))
+  (check-type time-limit-in-msec (or null (integer 0 #.(1- most-positive-fixnum))))
+  (multiple-value-bind (matchings interrupted-p)
+      (fuzzy-generate-matchings string default-package-name time-limit-in-msec)
+    (when (and limit
+               (> limit 0)
+               (< limit (length matchings)))
+      (if (array-has-fill-pointer-p matchings)
+          (setf (fill-pointer matchings) limit)
+          (setf matchings (make-array limit :displaced-to matchings))))
+    (map-into matchings #'(lambda (m)
+			    (fuzzy-convert-matching-for-emacs m string))
+	      matchings)
+    (values matchings interrupted-p)))
+
+
+(defun fuzzy-generate-matchings (string default-package-name time-limit-in-msec)
+  "Does all the hard work for FUZZY-COMPLETION-SET. If
+TIME-LIMIT-IN-MSEC is NIL, an infinite time limit is assumed."
+  (multiple-value-bind (parsed-symbol-name parsed-package-name package internal-p)
+      (parse-completion-arguments string default-package-name)
+    (flet ((fix-up (matchings parent-package-matching)
+	     ;; The components of each matching in MATCHINGS have been computed
+	     ;; relatively to PARENT-PACKAGE-MATCHING. Make them absolute.
+	     (let* ((p parent-package-matching)
+		    (p.name   (fuzzy-matching.package-name p))
+		    (p.score  (fuzzy-matching.score p))
+		    (p.chunks (fuzzy-matching.package-chunks p)))
+	       (map-into matchings
+			 #'(lambda (m)
+			     (let ((m.score (fuzzy-matching.score m)))
+			       (setf (fuzzy-matching.package-name m) p.name)
+			       (setf (fuzzy-matching.package-chunks m) p.chunks)
+			       (setf (fuzzy-matching.score m)
+				     (if (equal parsed-symbol-name "")
+					 ;; (Make package matchings be sorted before all the
+					 ;; relative symbol matchings while preserving over
+					 ;; all orderness.)
+					 (/ p.score 100)        
+					 (+ p.score m.score)))
+			       m))
+			 matchings)))
+	   (find-symbols (designator package time-limit &optional filter)
+	     (fuzzy-find-matching-symbols designator package
+					  :time-limit-in-msec time-limit
+					  :external-only (not internal-p)
+					  :filter (or filter #'identity)))
+	   (find-packages (designator time-limit)
+	     (fuzzy-find-matching-packages designator :time-limit-in-msec time-limit)))
+      (let ((time-limit time-limit-in-msec) (symbols) (packages) (results))
+	(cond ((not parsed-package-name) ; E.g. STRING = "asd"
+	       ;; We don't know if user is searching for a package or a symbol
+	       ;; within his current package. So we try to find either.
+	       (setf (values packages time-limit) (find-packages parsed-symbol-name time-limit))
+	       (setf (values symbols  time-limit) (find-symbols parsed-symbol-name package time-limit)))
+	      ((string= parsed-package-name "") ; E.g. STRING = ":" or ":foo"
+	       (setf (values symbols time-limit) (find-symbols parsed-symbol-name package time-limit)))
+	      (t		   ; E.g. STRING = "asd:" or "asd:foo"
+	       ;; Find fuzzy matchings of the denoted package identifier part.
+	       ;; After that, find matchings for the denoted symbol identifier
+	       ;; relative to all the packages found.
+	       (multiple-value-bind (found-packages rest-time-limit)
+		   (find-packages parsed-package-name time-limit-in-msec)
+		 (loop
+		       for package-matching across found-packages
+		       for package = (find-package (fuzzy-matching.package-name package-matching))
+		       while (or (not time-limit) (> rest-time-limit 0)) do
+		         (multiple-value-bind (matchings remaining-time)
+			     ;; The filter removes all those symbols which are also present
+			     ;; in one of the other packages, specifically if such a package
+			     ;; represents the home package of the symbol, because that one
+			     ;; is deemed to be the best match.
+			     (find-symbols parsed-symbol-name package rest-time-limit
+					   (%make-duplicate-symbols-filter
+					    (remove package-matching found-packages)))
+			   (setf matchings (fix-up matchings package-matching))
+			   (setf symbols   (concatenate 'vector symbols matchings))
+			   (setf rest-time-limit remaining-time)
+			   (let ((guessed-sort-duration (%guess-sort-duration (length symbols))))
+			     (when (<= rest-time-limit guessed-sort-duration)
+			       (decf rest-time-limit guessed-sort-duration)
+			       (loop-finish))))
+		       finally
+		         (setf time-limit rest-time-limit)
+		         (when (equal parsed-symbol-name "") ; E.g. STRING = "asd:"
+			   (setf packages found-packages))))))
+	;; Sort by score; thing with equal score, sort alphabetically.
+	;; (Especially useful when PARSED-SYMBOL-NAME is empty, and all possible
+	;; completions are to be returned.)
+	(setf results (concatenate 'vector symbols packages))
+	(setf results (sort results #'fuzzy-matching-greaterp))
+	(values results (and time-limit (<= time-limit 0)))))))
+
+(defun %guess-sort-duration (length)
+  ;; These numbers are pretty much arbitrary, except that they're
+  ;; vaguely correct on my machine with SBCL. Yes, this is an ugly
+  ;; kludge, but it's better than before (where this didn't exist at
+  ;; all, which essentially meant, that this was taken to be 0.)
+  (if (zerop length)
+      0
+      (let ((comparasions (* 3.8 (* length (log length 2)))))
+	(* 1000 (* comparasions (expt 10 -7)))))) ; msecs
+
+(defun %make-duplicate-symbols-filter (fuzzy-package-matchings)
+  ;; Returns a filter function that takes a symbol and which returns T
+  ;; only if no matching in FUZZY-PACKAGE-MATCHINGS represents the
+  ;; home-package of the.
+  (let ((packages (mapcar #'(lambda (m)
+			      (find-package (fuzzy-matching.package-name m)))
+			  (coerce fuzzy-package-matchings 'list))))
+    #'(lambda (symbol)
+	(not (member (symbol-package symbol) packages)))))
+
+(defun fuzzy-matching-greaterp (m1 m2)
+  "Returns T if fuzzy-matching M1 should be sorted before M2.
+Basically just the scores of the two matchings are compared, and
+the match with higher score wins. For the case that the score is
+equal, the one which comes alphabetically first wins."
+  (declare (type fuzzy-matching m1 m2))
+  (let ((score1 (fuzzy-matching.score m1))
+	(score2 (fuzzy-matching.score m2)))
+    (cond ((> score1 score2) t)
+	  ((< score1 score2) nil)	; total order
+	  (t
+	   (let ((name1 (symbol-name (fuzzy-matching.symbol m1)))
+		 (name2 (symbol-name (fuzzy-matching.symbol m2))))
+	     (string< name1 name2))))))
+
+
+(defun get-real-time-in-msecs ()
+  (let ((units-per-msec (max 1 (floor internal-time-units-per-second 1000))))
+    (values (floor (get-internal-real-time) units-per-msec)))) ; return just one value!
+
+(defun fuzzy-find-matching-symbols
+    (string package &key (filter #'identity) external-only time-limit-in-msec)
+  "Returns two values: a vector of fuzzy matchings for matching
+symbols in PACKAGE, using the fuzzy completion algorithm, and the
+remaining time limit.
+
+Only those symbols are considered of which FILTER does return T.
+
+If EXTERNAL-ONLY is true, only external symbols are considered. A
+TIME-LIMIT-IN-MSEC of NIL is considered no limit; if it's zero or
+negative, perform a NOP."
+  (let ((time-limit-p (and time-limit-in-msec t))
+        (time-limit (or time-limit-in-msec 0))
+        (rtime-at-start (get-real-time-in-msecs))
+	(package-name (package-name package))
+        (count 0))
+    (declare (type boolean time-limit-p))
+    (declare (type integer time-limit rtime-at-start))
+    (declare (type (integer 0 #.(1- most-positive-fixnum)) count))
+
+    (flet ((recompute-remaining-time (old-remaining-time)
+             (cond ((not time-limit-p)
+                    (values nil nil)) ; propagate NIL back as infinite time limit.
+                   ((> count 0)       ; ease up on getting internal time like crazy.
+                    (setf count (mod (1+ count) 128))
+                    (values nil old-remaining-time))
+                   (t (let* ((elapsed-time (- (get-real-time-in-msecs) rtime-at-start))
+                             (remaining (- time-limit elapsed-time)))
+                        (values (<= remaining 0) remaining)))))
+           (perform-fuzzy-match (string symbol-name)
+             (let* ((converter (completion-output-symbol-converter string))
+                    (converted-symbol-name (funcall converter symbol-name)))
+               (compute-highest-scoring-completion string converted-symbol-name))))
+      (let ((completions (make-array 256 :adjustable t :fill-pointer 0))
+            (rest-time-limit time-limit))
+        (block loop
+          (do-symbols* (symbol package)
+            (multiple-value-bind (exhausted? remaining-time)
+                (recompute-remaining-time rest-time-limit)
+              (setf rest-time-limit remaining-time)
+              (cond (exhausted? (return-from loop))
+                    ((or (not external-only) (symbol-external-p symbol package))
+		     (when (funcall filter symbol)
+		       (if (string= "" string) ; "" matches always
+			   (vector-push-extend (make-fuzzy-matching symbol package-name
+								    0.0 '() '())
+					       completions)
+			   (multiple-value-bind (match-result score)
+			       (perform-fuzzy-match string (symbol-name symbol))
+			     (when match-result
+			       (vector-push-extend
+				(make-fuzzy-matching symbol package-name score
+						     '() match-result)
+				completions))))))))))
+        (values completions rest-time-limit)))))
+
+
+(defun fuzzy-find-matching-packages (name &key time-limit-in-msec)
+  "Returns a vector of fuzzy matchings for each package that is
+similiar to NAME, and the remaining time limit. 
+Cf. FUZZY-FIND-MATCHING-SYMBOLS."
+  (let ((time-limit-p (and time-limit-in-msec t))
+        (time-limit (or time-limit-in-msec 0))
+        (rtime-at-start (get-real-time-in-msecs))
+        (converter (completion-output-package-converter name))
+        (completions (make-array 32 :adjustable t :fill-pointer 0)))
+    (declare (type boolean time-limit-p))
+    (declare (type integer time-limit rtime-at-start))
+    (declare (type function converter))
+    (if (and time-limit-p (<= time-limit 0))
+        (values #() time-limit)
+        (loop for package in (list-all-packages) do
+	      ;; Find best-matching package-nickname:
+              (loop with max-pkg-name = ""
+		    with max-result   = nil
+		    with max-score    = 0
+		    for package-name in (package-names package)
+		    for converted-name = (funcall converter package-name)
+		    do
+		    (multiple-value-bind (result score)
+			(compute-highest-scoring-completion name converted-name)
+		      (when (and result (> score max-score))
+			(setf max-pkg-name package-name)
+			(setf max-result   result)
+			(setf max-score    score)))
+		    finally
+		    (when max-result
+		      (vector-push-extend (make-fuzzy-matching nil max-pkg-name
+							       max-score max-result '())
+					  completions)))
+              finally
+                (return
+                  (values completions
+                          (and time-limit-p
+                               (let ((elapsed-time (- (get-real-time-in-msecs) rtime-at-start)))
+                                 (- time-limit elapsed-time)))))))))
+
+
+(defslimefun fuzzy-completion-selected (original-string completion)
+  "This function is called by Slime when a fuzzy completion is
+selected by the user.  It is for future expansion to make
+testing, say, a machine learning algorithm for completion scoring
+easier.
+
+ORIGINAL-STRING is the string the user completed from, and
+COMPLETION is the completion object (see docstring for
+SWANK:FUZZY-COMPLETIONS) corresponding to the completion that the
+user selected."
+  (declare (ignore original-string completion))
+  nil)
+
+
+;;;;; Fuzzy completion core
+
+(defparameter *fuzzy-recursion-soft-limit* 30
+  "This is a soft limit for recursion in
+RECURSIVELY-COMPUTE-MOST-COMPLETIONS.  Without this limit,
+completing a string such as \"ZZZZZZ\" with a symbol named
+\"ZZZZZZZZZZZZZZZZZZZZZZZ\" will result in explosive recursion to
+find all the ways it can match.
+
+Most natural language searches and symbols do not have this
+problem -- this is only here as a safeguard.")
+(declaim (fixnum *fuzzy-recursion-soft-limit*))
+
+(defun compute-highest-scoring-completion (short full)
+  "Finds the highest scoring way to complete the abbreviation
+SHORT onto the string FULL, using CHAR= as a equality function for
+letters.  Returns two values:  The first being the completion
+chunks of the highest scorer, and the second being the score."
+  (let* ((scored-results
+          (mapcar #'(lambda (result)
+                      (cons (score-completion result short full) result))
+                  (compute-most-completions short full)))
+         (winner (first (sort scored-results #'> :key #'first))))
+    (values (rest winner) (first winner))))
+
+(defun compute-most-completions (short full)
+  "Finds most possible ways to complete FULL with the letters in SHORT.
+Calls RECURSIVELY-COMPUTE-MOST-COMPLETIONS recursively.  Returns
+a list of (&rest CHUNKS), where each CHUNKS is a description of
+how a completion matches."
+  (let ((*all-chunks* nil))
+    (declare (special *all-chunks*))
+    (recursively-compute-most-completions short full 0 0 nil nil nil t)
+    *all-chunks*))
+
+(defun recursively-compute-most-completions 
+    (short full 
+     short-index initial-full-index 
+     chunks current-chunk current-chunk-pos 
+     recurse-p)
+  "Recursively (if RECURSE-P is true) find /most/ possible ways
+to fuzzily map the letters in SHORT onto FULL, using CHAR= to
+determine if two letters match.
+
+A chunk is a list of elements that have matched consecutively.
+When consecutive matches stop, it is coerced into a string,
+paired with the starting position of the chunk, and pushed onto
+CHUNKS.
+
+Whenever a letter matches, if RECURSE-P is true,
+RECURSIVELY-COMPUTE-MOST-COMPLETIONS calls itself with a position
+one index ahead, to find other possibly higher scoring
+possibilities.  If there are less than
+*FUZZY-RECURSION-SOFT-LIMIT* results in *ALL-CHUNKS* currently,
+this call will also recurse.
+
+Once a word has been completely matched, the chunks are pushed
+onto the special variable *ALL-CHUNKS* and the function returns."
+  (declare ;(optimize speed)
+           (fixnum short-index initial-full-index)
+           (simple-string short full)
+           (special *all-chunks*))
+  (flet ((short-cur () 
+           "Returns the next letter from the abbreviation, or NIL
+            if all have been used."
+           (if (= short-index (length short))
+               nil
+               (aref short short-index)))
+         (add-to-chunk (char pos)
+           "Adds the CHAR at POS in FULL to the current chunk,
+            marking the start position if it is empty."
+           (unless current-chunk
+             (setf current-chunk-pos pos))
+           (push char current-chunk))
+         (collect-chunk ()
+           "Collects the current chunk to CHUNKS and prepares for
+            a new chunk."
+           (when current-chunk
+             (push (list current-chunk-pos
+                         (coerce (reverse current-chunk) 'string)) chunks)
+             (setf current-chunk nil
+                   current-chunk-pos nil))))
+    ;; If there's an outstanding chunk coming in collect it.  Since
+    ;; we're recursively called on skipping an input character, the
+    ;; chunk can't possibly continue on.
+    (when current-chunk (collect-chunk))
+    (do ((pos initial-full-index (1+ pos)))
+        ((= pos (length full)))
+      (let ((cur-char (aref full pos)))
+        (if (and (short-cur) 
+                 (char= cur-char (short-cur)))
+            (progn
+              (when recurse-p
+                ;; Try other possibilities, limiting insanely deep
+                ;; recursion somewhat.
+                (recursively-compute-most-completions 
+                 short full short-index (1+ pos) 
+                 chunks current-chunk current-chunk-pos
+                 (not (> (length *all-chunks*) 
+                         *fuzzy-recursion-soft-limit*))))
+              (incf short-index)
+              (add-to-chunk cur-char pos))
+            (collect-chunk))))
+    (collect-chunk)
+    ;; If we've exhausted the short characters we have a match.
+    (if (short-cur)
+        nil
+        (let ((rev-chunks (reverse chunks)))
+          (push rev-chunks *all-chunks*)
+          rev-chunks))))
+
+
+;;;;; Fuzzy completion scoring
+
+(defparameter *fuzzy-completion-symbol-prefixes* "*+-%&?<"
+  "Letters that are likely to be at the beginning of a symbol.
+Letters found after one of these prefixes will be scored as if
+they were at the beginning of ths symbol.")
+(defparameter *fuzzy-completion-symbol-suffixes* "*+->"
+  "Letters that are likely to be at the end of a symbol.
+Letters found before one of these suffixes will be scored as if
+they were at the end of the symbol.")
+(defparameter *fuzzy-completion-word-separators* "-/."
+  "Letters that separate different words in symbols.  Letters
+after one of these symbols will be scores more highly than other
+letters.")
+
+(defun score-completion (completion short full)
+  "Scores the completion chunks COMPLETION as a completion from
+the abbreviation SHORT to the full string FULL.  COMPLETION is a
+list like:
+    ((0 \"mul\") (9 \"v\") (15 \"b\"))
+Which, if SHORT were \"mulvb\" and full were \"multiple-value-bind\", 
+would indicate that it completed as such (completed letters
+capitalized):
+    MULtiple-Value-Bind
+
+Letters are given scores based on their position in the string.
+Letters at the beginning of a string or after a prefix letter at
+the beginning of a string are scored highest.  Letters after a
+word separator such as #\- are scored next highest.  Letters at
+the end of a string or before a suffix letter at the end of a
+string are scored medium, and letters anywhere else are scored
+low.
+
+If a letter is directly after another matched letter, and its
+intrinsic value in that position is less than a percentage of the
+previous letter's value, it will use that percentage instead.
+
+Finally, a small scaling factor is applied to favor shorter
+matches, all other things being equal."
+  (labels ((at-beginning-p (pos) 
+             (= pos 0))
+           (after-prefix-p (pos) 
+             (and (= pos 1) 
+                  (find (aref full 0) *fuzzy-completion-symbol-prefixes*)))
+           (word-separator-p (pos)
+             (find (aref full pos) *fuzzy-completion-word-separators*))
+           (after-word-separator-p (pos)
+             (find (aref full (1- pos)) *fuzzy-completion-word-separators*))
+           (at-end-p (pos)
+             (= pos (1- (length full))))
+           (before-suffix-p (pos)
+             (and (= pos (- (length full) 2))
+                  (find (aref full (1- (length full)))
+                        *fuzzy-completion-symbol-suffixes*)))
+           (score-or-percentage-of-previous (base-score pos chunk-pos)
+             (if (zerop chunk-pos) 
+                 base-score 
+                 (max base-score 
+                      (+ (* (score-char (1- pos) (1- chunk-pos)) 0.85)
+                         (expt 1.2 chunk-pos)))))
+           (score-char (pos chunk-pos)
+             (score-or-percentage-of-previous
+              (cond ((at-beginning-p pos)         10)
+                    ((after-prefix-p pos)         10)
+                    ((word-separator-p pos)       1)
+                    ((after-word-separator-p pos) 8)
+                    ((at-end-p pos)               6)
+                    ((before-suffix-p pos)        6)
+                    (t                            1))
+              pos chunk-pos))
+           (score-chunk (chunk)
+             (loop for chunk-pos below (length (second chunk))
+                   for pos from (first chunk) 
+                   summing (score-char pos chunk-pos))))
+    (let* ((chunk-scores (mapcar #'score-chunk completion))
+           (length-score (/ 10.0 (1+ (- (length full) (length short))))))
+      (values
+       (+ (reduce #'+ chunk-scores) length-score)
+       (list (mapcar #'list chunk-scores completion) length-score)))))
+
+(defun highlight-completion (completion full)
+  "Given a chunk definition COMPLETION and the string FULL,
+HIGHLIGHT-COMPLETION will create a string that demonstrates where
+the completion matched in the string.  Matches will be
+capitalized, while the rest of the string will be lower-case."
+  (let ((highlit (nstring-downcase (copy-seq full))))
+    (dolist (chunk completion)
+      (setf highlit (nstring-upcase highlit 
+                                    :start (first chunk)
+                                    :end (+ (first chunk) 
+                                            (length (second chunk))))))
+    highlit))
+
+(defun format-fuzzy-completion-set (winners)
+  "Given a list of completion objects such as on returned by
+FUZZY-COMPLETION-SET, format the list into user-readable output
+for interactive debugging purpose."
+  (let ((max-len 
+         (loop for winner in winners maximizing (length (first winner)))))
+    (loop for (sym score result) in winners do
+          (format t "~&~VA  score ~8,2F  ~A"
+                  max-len (highlight-completion result sym) score result))))
+
+(provide :swank-fuzzy)
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-listener-hooks.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,82 @@
+;;; swank-listener-hooks.lisp --- listener with special hooks
+;;
+;; Author: Alan Ruttenberg  <alanr-l at mumble.net>
+
+;; I guess that only Alan Ruttenberg knows how to use this code.  It
+;; was in swank.lisp for a long time, so here it is. -- Helmut Eller
+
+(defvar *slime-repl-advance-history* nil 
+  "In the dynamic scope of a single form typed at the repl, is set to nil to 
+   prevent the repl from advancing the history - * ** *** etc.")
+
+(defvar *slime-repl-suppress-output* nil
+  "In the dynamic scope of a single form typed at the repl, is set to nil to
+   prevent the repl from printing the result of the evalation.")
+  
+(defvar *slime-repl-eval-hook-pass* (gensym "PASS")
+  "Token to indicate that a repl hook declines to evaluate the form")
+
+(defvar *slime-repl-eval-hooks* nil
+  "A list of functions. When the repl is about to eval a form, first try running each of
+   these hooks. The first hook which returns a value which is not *slime-repl-eval-hook-pass*
+   is considered a replacement for calling eval. If there are no hooks, or all
+   pass, then eval is used.")
+
+(defslimefun repl-eval-hook-pass ()
+  "call when repl hook declines to evaluate the form"
+  (throw *slime-repl-eval-hook-pass* *slime-repl-eval-hook-pass*))
+
+(defslimefun repl-suppress-output ()
+  "In the dynamic scope of a single form typed at the repl, call to
+   prevent the repl from printing the result of the evalation."
+  (setq *slime-repl-suppress-output* t))
+
+(defslimefun repl-suppress-advance-history ()
+  "In the dynamic scope of a single form typed at the repl, call to 
+   prevent the repl from advancing the history - * ** *** etc."
+  (setq *slime-repl-advance-history* nil))
+
+(defun %eval-region (string)
+  (with-input-from-string (stream string)
+    (let (- values)
+      (loop
+       (let ((form (read stream nil stream)))
+	 (when (eq form stream)
+	   (fresh-line)
+	   (finish-output)
+	   (return (values values -)))
+	 (setq - form)
+	 (if *slime-repl-eval-hooks* 
+	     (setq values (run-repl-eval-hooks form))
+	     (setq values (multiple-value-list (eval form))))
+	 (finish-output))))))
+
+(defun run-repl-eval-hooks (form)
+  (loop for hook in *slime-repl-eval-hooks* 
+	for res =  (catch *slime-repl-eval-hook-pass* 
+		     (multiple-value-list (funcall hook form)))
+	until (not (eq res *slime-repl-eval-hook-pass*))
+	finally (return 
+		  (if (eq res *slime-repl-eval-hook-pass*)
+		      (multiple-value-list (eval form))
+		      res))))
+
+(defun %listener-eval (string)
+  (clear-user-input)
+  (with-buffer-syntax ()
+    (track-package 
+     (lambda ()
+       (let ((*slime-repl-suppress-output* :unset)
+	     (*slime-repl-advance-history* :unset))
+	 (multiple-value-bind (values last-form) (%eval-region string)
+	   (unless (or (and (eq values nil) (eq last-form nil))
+		       (eq *slime-repl-advance-history* nil))
+	     (setq *** **  ** *  * (car values)
+		   /// //  // /  / values))
+	   (setq +++ ++  ++ +  + last-form)
+	   (unless (eq *slime-repl-suppress-output* t)
+	     (funcall *send-repl-results-function* values))))))))
+
+(setq *listener-eval-function* '%listener-eval)
+
+(provide :swank-listener-hooks)

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,319 @@
+;;; swank-presentation-streams.lisp --- Streams that allow attaching object identities
+;;;                                     to portions of output
+;;;
+;;; Authors: Alan Ruttenberg  <alanr-l at mumble.net>
+;;;          Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;;          Helmut Eller  <heller at common-lisp.net>
+;;;
+;;; License: This code has been placed in the Public Domain.  All warranties
+;;;          are disclaimed.
+
+(in-package :swank)
+
+(swank-require :swank-presentations)
+
+;; This file contains a mechanism for printing to the slime repl so
+;; that the printed result remembers what object it is associated
+;; with.  This extends the recording of REPL results.
+;;
+;; There are two methods:
+;;
+;; 1. Depends on the ilisp bridge code being installed and ready to
+;;    intercept messages in the printed stream. We encode the
+;;    information with a message saying that we are starting to print
+;;    an object corresponding to a given id and another when we are
+;;    done. The process filter notices these and adds the necessary
+;;    text properties to the output.
+;;
+;; 2. Use separate protocol messages :presentation-start and
+;;    :presentation-end for sending presentations.
+;;
+;; We only do this if we know we are printing to a slime stream,
+;; checked with the method slime-stream-p. Initially this checks for
+;; the knows slime streams looking at *connections*. In cmucl, sbcl, and
+;; openmcl it also checks if it is a pretty-printing stream which
+;; ultimately prints to a slime stream.
+;;
+;; Method 1 seems to be faster, but the printed escape sequences can 
+;; disturb the column counting, and thus the layout in pretty-printing.
+;; We use method 1 when a dedicated output stream is used.  
+;;
+;; Method 2 is cleaner and works with pretty printing if the pretty
+;; printers support "annotations".  We use method 2 when no dedicated
+;; output stream is used.
+
+;; Control
+(defvar *enable-presenting-readable-objects* t
+  "set this to enable automatically printing presentations for some
+subset of readable objects, such as pathnames."  )
+
+;; doing it
+
+(defmacro presenting-object (object stream &body body)
+  "What you use in your code. Wrap this around some printing and that text will
+be sensitive and remember what object it is in the repl"
+  `(presenting-object-1 ,object ,stream #'(lambda () , at body)))
+
+(defmacro presenting-object-if (predicate object stream &body body)
+  "What you use in your code. Wrap this around some printing and that text will
+be sensitive and remember what object it is in the repl if predicate is true"
+  (let ((continue (gensym)))
+  `(let ((,continue #'(lambda () , at body)))
+    (if ,predicate
+	(presenting-object-1 ,object ,stream ,continue)
+	(funcall ,continue)))))
+
+;;; Get pretty printer patches for SBCL at load (not compile) time.
+#+sbcl
+(eval-when (:load-toplevel)
+  (handler-bind ((simple-error 
+		  (lambda (c) 
+		    (declare (ignore c))
+		    (let ((clobber-it (find-restart 'sb-kernel::clobber-it)))
+		      (when clobber-it (invoke-restart clobber-it))))))
+    (sb-ext:without-package-locks
+      (swank-backend::with-debootstrapping
+	(load (make-pathname 
+	       :name "sbcl-pprint-patch"
+	       :type "lisp"
+	       :directory (pathname-directory swank-loader:*source-directory*)))))))
+
+(let ((last-stream nil)
+      (last-answer nil))
+  (defun slime-stream-p (stream)
+    "Check if stream is one of the slime streams, since if it isn't we
+don't want to present anything.
+Two special return values: 
+:DEDICATED -- Output ends up on a dedicated output stream
+:REPL-RESULT -- Output ends up on the :repl-results target.
+"
+    (if (eq last-stream stream)
+	last-answer
+	(progn
+	  (setq last-stream stream)
+	  (if (eq stream t) 
+	      (setq stream *standard-output*))
+	  (setq last-answer 
+		(or #+openmcl 
+		    (and (typep stream 'ccl::xp-stream) 
+					;(slime-stream-p (ccl::xp-base-stream (slot-value stream 'ccl::xp-structure)))
+			 (slime-stream-p (ccl::%svref (slot-value stream 'ccl::xp-structure) 1)))
+		    #+cmu
+		    (or (and (typep stream 'lisp::indenting-stream)
+			     (slime-stream-p (lisp::indenting-stream-stream stream)))
+			(and (typep stream 'pretty-print::pretty-stream)
+			     (fboundp 'pretty-print::enqueue-annotation)
+			     (let ((slime-stream-p
+				    (slime-stream-p (pretty-print::pretty-stream-target stream))))
+			       (and ;; Printing through CMUCL pretty
+				    ;; streams is only cleanly
+				    ;; possible if we are using the
+				    ;; bridge-less protocol with
+				    ;; annotations, because the bridge
+				    ;; escape sequences disturb the
+				    ;; pretty printer layout.
+				    (not (eql slime-stream-p :dedicated-output))
+				    ;; If OK, return the return value
+				    ;; we got from slime-stream-p on
+				    ;; the target stream (could be
+				    ;; :repl-result):
+				    slime-stream-p))))
+		    #+sbcl
+		    (let ()
+		      (declare (notinline sb-pretty::pretty-stream-target))
+		      (or (and (typep stream 'sb-impl::indenting-stream)
+			       (slime-stream-p (sb-impl::indenting-stream-stream stream)))
+			  (and (typep stream (find-symbol "PRETTY-STREAM" 'sb-pretty))
+			       (find-symbol "ENQUEUE-ANNOTATION" 'sb-pretty)
+			       (not *use-dedicated-output-stream*)
+			       (slime-stream-p (sb-pretty::pretty-stream-target stream)))))
+		    #+allegro
+		    (and (typep stream 'excl:xp-simple-stream)
+			 (slime-stream-p (excl::stream-output-handle stream)))
+		    (loop for connection in *connections*
+			  thereis (or (and (eq stream (connection.dedicated-output connection))
+					   :dedicated)
+				      (eq stream (connection.socket-io connection))
+				      (eq stream (connection.user-output connection))
+				      (eq stream (connection.user-io connection))
+				      (and (eq stream (connection.repl-results connection))
+					   :repl-result)))))))))
+
+(defun can-present-readable-objects (&optional stream)
+  (declare (ignore stream))
+  *enable-presenting-readable-objects*)
+
+;; If we are printing to an XP (pretty printing) stream, printing the
+;; escape sequences directly would mess up the layout because column
+;; counting is disturbed.  Use "annotations" instead.
+#+allegro
+(defun write-annotation (stream function arg)
+  (if (typep stream 'excl:xp-simple-stream)
+      (excl::schedule-annotation stream function arg)
+      (funcall function arg stream nil)))
+#+cmu
+(defun write-annotation (stream function arg)
+  (if (and (typep stream 'pp:pretty-stream)
+	   (fboundp 'pp::enqueue-annotation))
+      (pp::enqueue-annotation stream function arg)
+      (funcall function arg stream nil)))
+#+sbcl
+(defun write-annotation (stream function arg)
+  (let ((enqueue-annotation
+	 (find-symbol "ENQUEUE-ANNOTATION" 'sb-pretty)))
+    (if (and enqueue-annotation
+	     (typep stream (find-symbol "PRETTY-STREAM" 'sb-pretty)))
+	(funcall enqueue-annotation stream function arg)
+	(funcall function arg stream nil))))
+#-(or allegro cmu sbcl)
+(defun write-annotation (stream function arg)
+  (funcall function arg stream nil))
+
+(defstruct presentation-record 
+  (id)
+  (printed-p)
+  (target))
+
+(defun presentation-start (record stream truncatep) 
+  (unless truncatep
+    ;; Don't start new presentations when nothing is going to be
+    ;; printed due to *print-lines*.
+    (let ((pid (presentation-record-id record))
+	  (target (presentation-record-target record)))
+      (case target
+	(:dedicated 
+	 ;; Use bridge protocol
+	 (write-string "<" stream)
+	 (prin1 pid stream)
+	 (write-string "" stream))
+	(t
+	 (finish-output stream)
+	 (send-to-emacs `(:presentation-start ,pid ,target)))))
+    (setf (presentation-record-printed-p record) t)))
+	   
+(defun presentation-end (record stream truncatep)
+  (declare (ignore truncatep))
+  ;; Always end old presentations that were started.
+  (when (presentation-record-printed-p record)
+    (let ((pid (presentation-record-id record))
+	  (target (presentation-record-target record)))
+      (case target
+	(:dedicated 
+	 ;; Use bridge protocol
+	 (write-string ">" stream)
+	 (prin1 pid stream)
+	 (write-string "" stream))
+	(t
+	 (finish-output stream)
+	 (send-to-emacs `(:presentation-end ,pid ,target)))))))
+
+(defun presenting-object-1 (object stream continue)
+  "Uses the bridge mechanism with two messages >id and <id. The first one
+says that I am starting to print an object with this id. The second says I am finished"
+  (let ((slime-stream-p 
+	 (and *record-repl-results* (slime-stream-p stream))))
+    (if slime-stream-p
+	(let* ((pid (swank::save-presented-object object))
+	       (record (make-presentation-record :id pid :printed-p nil
+						 :target (if (eq slime-stream-p :repl-result)
+							     :repl-result
+							     nil))))
+	  (write-annotation stream #'presentation-start record)
+	  (multiple-value-prog1
+	      (funcall continue)
+	    (write-annotation stream #'presentation-end record)))
+	(funcall continue))))
+
+(defun present-repl-results-via-presentation-streams (values)
+  ;; Override a function in swank.lisp, so that 
+  ;; nested presentations work in the REPL result.
+  (let ((repl-results (connection.repl-results *emacs-connection*)))
+    (flet ((send (value)
+	     (presenting-object value repl-results
+	       (prin1 value repl-results))
+	     (terpri repl-results)))
+      (if (null values)
+	  (progn 
+	    (princ "; No value" repl-results)
+	    (terpri repl-results))
+	  (mapc #'send values)))
+    (finish-output repl-results)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Example: Tell openmcl and cmucl to always present unreadable objects. try (describe 'class) 
+#+openmcl
+(in-package :ccl)
+#+openmcl
+(let ((*warn-if-redefine-kernel* nil)
+      (*warn-if-redefine* nil))
+  (defun %print-unreadable-object (object stream type id thunk)
+    (cond ((null stream) (setq stream *standard-output*))
+	  ((eq stream t) (setq stream *terminal-io*)))
+    (swank::presenting-object object stream
+      (write-unreadable-start object stream)
+      (when type
+	(princ (type-of object) stream)
+	(stream-write-char stream #\space))
+      (when thunk 
+	(funcall thunk))
+      (if id
+	  (%write-address object stream #\>)
+	  (pp-end-block stream ">"))
+      nil))
+  (defmethod print-object :around ((pathname pathname) stream)
+    (swank::presenting-object-if
+	(swank::can-present-readable-objects stream)
+	pathname stream (call-next-method))))
+
+#+openmcl
+(ccl::def-load-pointers clear-presentations ()
+  (swank::clear-presentation-tables))
+
+(in-package :swank)
+
+#+cmu
+(progn
+  (fwrappers:define-fwrapper presenting-unreadable-wrapper (object stream type identity body)
+    (presenting-object object stream
+      (fwrappers:call-next-function)))
+
+  (fwrappers:define-fwrapper presenting-pathname-wrapper (pathname stream depth)
+    (presenting-object-if (can-present-readable-objects stream) pathname stream
+      (fwrappers:call-next-function)))
+
+  (fwrappers::fwrap 'lisp::%print-pathname  #'presenting-pathname-wrapper)
+  (fwrappers::fwrap 'lisp::%print-unreadable-object  #'presenting-unreadable-wrapper)
+  )
+
+#+sbcl
+(progn 
+  (defvar *saved-%print-unreadable-object*
+    (fdefinition 'sb-impl::%print-unreadable-object))
+  (sb-ext:without-package-locks 
+    (setf (fdefinition 'sb-impl::%print-unreadable-object)
+	  (lambda (object stream type identity body)
+	    (presenting-object object stream
+	      (funcall *saved-%print-unreadable-object* 
+		       object stream type identity body))))
+    (defmethod print-object :around ((object pathname) stream)
+      (presenting-object object stream
+	(call-next-method)))))
+
+#+allegro
+(progn
+  (excl:def-fwrapper presenting-unreadable-wrapper (object stream type identity continuation) 
+    (swank::presenting-object object stream (excl:call-next-fwrapper)))
+  (excl:def-fwrapper presenting-pathname-wrapper (pathname stream depth)
+    (presenting-object-if (can-present-readable-objects stream) pathname stream
+      (excl:call-next-fwrapper)))
+  (excl:fwrap 'excl::print-unreadable-object-1 
+	      'print-unreadable-present 'presenting-unreadable-wrapper)
+  (excl:fwrap 'excl::pathname-printer 
+	      'print-pathname-present 'presenting-pathname-wrapper))
+
+;; Hook into SWANK.
+
+(setq *send-repl-results-function* 'present-repl-results-via-presentation-streams)
+
+(provide :swank-presentation-streams)

Added: branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/contrib/swank-presentations.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,235 @@
+;;; swank-presentations.lisp --- imitate LispM's presentations
+;;
+;; Authors: Alan Ruttenberg  <alanr-l at mumble.net>
+;;          Luke Gorrie  <luke at synap.se>
+;;          Helmut Eller  <heller at common-lisp.net>
+;;          Matthias Koeppe  <mkoeppe at mail.math.uni-magdeburg.de>
+;;
+;; License: This code has been placed in the Public Domain.  All warranties
+;;          are disclaimed.
+;;
+
+(in-package :swank)
+
+;;;; Recording and accessing results of computations
+
+(defvar *record-repl-results* t
+  "Non-nil means that REPL results are saved for later lookup.")
+
+(defvar *object-to-presentation-id* 
+  (make-weak-key-hash-table :test 'eq)
+  "Store the mapping of objects to numeric identifiers")
+
+(defvar *presentation-id-to-object* 
+  (make-weak-value-hash-table :test 'eql)
+  "Store the mapping of numeric identifiers to objects")
+
+(defun clear-presentation-tables ()
+  (clrhash *object-to-presentation-id*)
+  (clrhash *presentation-id-to-object*))
+
+(defvar *presentation-counter* 0 "identifier counter")
+
+(defvar *nil-surrogate* (make-symbol "nil-surrogate"))
+
+;; XXX thread safety? [2006-09-13] mb: not in the slightest (fwiw the
+;; rest of slime isn't thread safe either), do we really care?
+(defun save-presented-object (object)
+  "Save OBJECT and return the assigned id.
+If OBJECT was saved previously return the old id."
+  (let ((object (if (null object) *nil-surrogate* object)))
+    ;; We store *nil-surrogate* instead of nil, to distinguish it from
+    ;; an object that was garbage collected.
+    (or (gethash object *object-to-presentation-id*)
+        (let ((id (incf *presentation-counter*)))
+          (setf (gethash id *presentation-id-to-object*) object)
+          (setf (gethash object *object-to-presentation-id*) id)
+          id))))
+
+(defun lookup-presented-object (id)
+  "Retrieve the object corresponding to ID.
+The secondary value indicates the absence of an entry."
+  (etypecase id
+    (integer 
+     ;; 
+     (multiple-value-bind (object foundp)
+         (gethash id *presentation-id-to-object*)
+       (cond
+         ((eql object *nil-surrogate*)
+          ;; A stored nil object
+          (values nil t))
+         ((null object)
+          ;; Object that was replaced by nil in the weak hash table
+          ;; when the object was garbage collected.
+          (values nil nil))
+         (t 
+          (values object foundp)))))
+    (cons
+     (destructure-case id
+       ((:frame-var thread-id frame index)
+        (declare (ignore thread-id)) ; later 
+        (handler-case 
+            (frame-var-value frame index)
+          (t (condition)
+            (declare (ignore condition))
+            (values nil nil))
+          (:no-error (value)
+            (values value t))))
+       ((:inspected-part part-index)
+        (declare (special *inspectee-parts*))
+        (if (< part-index (length *inspectee-parts*))
+            (values (inspector-nth-part part-index) t)
+            (values nil nil)))))))
+
+(defslimefun get-repl-result (id)
+  "Get the result of the previous REPL evaluation with ID."
+  (multiple-value-bind (object foundp) (lookup-presented-object id)
+    (cond (foundp object)
+          (t (error "Attempt to access unrecorded object (id ~D)." id)))))
+
+(defslimefun clear-repl-results ()
+  "Forget the results of all previous REPL evaluations."
+  (clear-presentation-tables)
+  t)
+
+(defun present-repl-results (values)
+  ;; Override a function in swank.lisp, so that 
+  ;; presentations are associated with every REPL result.
+  (flet ((send (value)
+           (let ((id (and *record-repl-results*
+                          (save-presented-object value))))
+	     (send-to-emacs `(:presentation-start ,id :repl-result))
+	     (send-to-emacs `(:write-string ,(prin1-to-string value)
+					    :repl-result))
+	     (send-to-emacs `(:presentation-end ,id :repl-result))
+	     (send-to-emacs `(:write-string ,(string #\Newline) 
+					    :repl-result)))))
+    (if (null values)
+        (send-to-emacs `(:write-string "; No value" :repl-result))
+        (mapc #'send values))))
+
+
+;;;; Presentation menu protocol
+;;
+;; To define a menu for a type of object, define a method
+;; menu-choices-for-presentation on that object type.  This function
+;; should return a list of two element lists where the first element is
+;; the name of the menu action and the second is a function that will be
+;; called if the menu is chosen. The function will be called with 3
+;; arguments:
+;;
+;; choice: The string naming the action from above
+;;
+;; object: The object 
+;;
+;; id: The presentation id of the object
+;;
+;; You might want append (when (next-method-p) (call-next-method)) to
+;; pick up the Menu actions of superclasses.
+;;
+
+(defvar *presentation-active-menu* nil)
+
+(defun menu-choices-for-presentation-id (id)
+  (multiple-value-bind (ob presentp) (lookup-presented-object id)
+    (cond ((not presentp) 'not-present)
+	  (t
+	   (let ((menu-and-actions (menu-choices-for-presentation ob)))
+	     (setq *presentation-active-menu* (cons id menu-and-actions))
+	     (mapcar 'car menu-and-actions))))))
+
+(defun swank-ioify (thing)
+  (cond ((keywordp thing) thing)
+	((and (symbolp thing)(not (find #\: (symbol-name thing))))
+	 (intern (symbol-name thing) 'swank-io-package))
+	((consp thing) (cons (swank-ioify (car thing)) (swank-ioify (cdr thing))))
+	(t thing)))
+
+(defun execute-menu-choice-for-presentation-id (id count item)
+  (let ((ob (lookup-presented-object id)))
+    (assert (equal id (car *presentation-active-menu*)) () 
+	    "Bug: Execute menu call for id ~a  but menu has id ~a"
+	    id (car *presentation-active-menu*))
+    (let ((action (second (nth (1- count) (cdr *presentation-active-menu*)))))
+      (swank-ioify (funcall action item ob id)))))
+
+
+(defgeneric menu-choices-for-presentation (object)
+  (:method (ob) (declare (ignore ob)) nil)) ; default method
+
+;; Pathname
+(defmethod menu-choices-for-presentation ((ob pathname))
+  (let* ((file-exists (ignore-errors (probe-file ob)))
+	 (lisp-type (make-pathname :type "lisp"))
+	 (source-file (and (not (member (pathname-type ob) '("lisp" "cl") :test 'equal))
+			   (let ((source (merge-pathnames lisp-type ob)))
+			     (and (ignore-errors (probe-file source))
+				  source))))
+	 (fasl-file (and file-exists 
+			 (equal (ignore-errors
+				  (namestring
+				   (truename
+				    (compile-file-pathname
+				     (merge-pathnames lisp-type ob)))))
+				(namestring (truename ob))))))
+    (remove nil 
+	    (list*
+	     (and (and file-exists (not fasl-file))
+		  (list "Edit this file" 
+			(lambda(choice object id) 
+			  (declare (ignore choice id))
+			  (ed-in-emacs (namestring (truename object)))
+			  nil)))
+	     (and file-exists
+		  (list "Dired containing directory"
+			(lambda (choice object id)
+			  (declare (ignore choice id))
+			  (ed-in-emacs (namestring 
+					(truename
+					 (merge-pathnames
+					  (make-pathname :name "" :type "") object))))
+			  nil)))
+	     (and fasl-file
+		  (list "Load this fasl file"
+			(lambda (choice object id)
+			  (declare (ignore choice id object)) 
+			  (load ob)
+			  nil)))
+	     (and fasl-file
+		  (list "Delete this fasl file"
+			(lambda (choice object id)
+			  (declare (ignore choice id object)) 
+			  (let ((nt (namestring (truename ob))))
+			    (when (y-or-n-p-in-emacs "Delete ~a? " nt)
+			      (delete-file nt)))
+			  nil)))
+	     (and source-file 
+		  (list "Edit lisp source file" 
+			(lambda (choice object id) 
+			  (declare (ignore choice id object)) 
+			  (ed-in-emacs (namestring (truename source-file)))
+			  nil)))
+	     (and source-file 
+		  (list "Load lisp source file" 
+			(lambda(choice object id) 
+			  (declare (ignore choice id object)) 
+			  (load source-file)
+			  nil)))
+	     (and (next-method-p) (call-next-method))))))
+
+(defmethod menu-choices-for-presentation ((ob function))
+  (list (list "Disassemble"
+              (lambda (choice object id) 
+                (declare (ignore choice id)) 
+                (disassemble object)))))
+
+(defslimefun inspect-presentation (id reset-p)
+  (let ((what (lookup-presented-object id)))
+    (when reset-p
+      (reset-inspector))
+    (inspect-object what)))
+
+
+(setq *send-repl-results-function* 'present-repl-results)
+
+(provide :swank-presentations)

Added: branches/trunk-reorg/thirdparty/slime/doc/.cvsignore
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/.cvsignore	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/.cvsignore	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,15 @@
+contributors.texi
+slime.aux
+slime.cp
+slime.dvi
+slime.fn
+slime.info
+slime.ky
+slime.log
+slime.pdf
+slime.pg
+slime.ps
+slime.tmp
+slime.toc
+slime.tp
+slime.vr

Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,9 @@
+/.cvsignore/1.1/Mon Jul 24 14:13:23 2006//
+/Makefile/1.12/Mon Sep 17 14:04:27 2007//
+/slime-refcard.pdf/1.1/Thu Aug  9 09:18:50 2007//
+/slime-refcard.tex/1.1/Thu Aug  9 09:18:50 2007//
+/slime-small.eps/1.1/Wed Nov 22 06:27:38 2006//
+/slime-small.pdf/1.1/Wed Nov 22 06:27:38 2006//
+/slime.texi/1.57/Mon Sep 17 13:44:48 2007//
+/texinfo-tabulate.awk/1.2/Mon Aug 29 20:02:57 2005//
+D

Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Repository	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+slime/doc

Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Root
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/CVS/Root	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Root	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1 @@
+:pserver:anonymous:anonymous at common-lisp.net:/project/slime/cvsroot

Added: branches/trunk-reorg/thirdparty/slime/doc/CVS/Template
===================================================================

Added: branches/trunk-reorg/thirdparty/slime/doc/Makefile
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/Makefile	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/Makefile	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,97 @@
+# This file has been placed in the public domain.
+#
+# Where to put the info file(s). NB: the GNU Coding Standards (GCS)
+# and the Filesystem Hierarchy Standard (FHS) differ on where info
+# files belong. The GCS says /usr/local/info; the FHS says
+# /usr/local/share/info. Many distros obey the FHS, but people who
+# installed their emacs from source probably have a GCS-ish file
+# hierarchy.
+infodir=/usr/local/info
+
+# What command to use to install info file(s)
+INSTALL_CMD=install -m 644
+
+# Info files generated here.
+infofiles=slime.info
+
+TEXI = slime.texi contributors.texi
+
+all: slime.info slime.pdf html/index.html
+
+slime.dvi: $(TEXI)
+	texi2dvi slime.texi
+
+slime.ps: slime.dvi
+	dvips -o $@ $<
+
+slime.info: $(TEXI)
+	makeinfo $<
+
+slime.html: $(TEXI)
+	texi2html $<
+
+html/index.html: $(TEXI)
+	makeinfo -o html --html $<
+
+slime.pdf: $(TEXI)
+	texi2pdf $<
+
+install: install-info
+
+uninstall: uninstall-info
+
+# Create contributors.texi, a texinfo table listing all known
+# contributors of code.
+#
+# Explicitly includes Eric Marsden (pre-ChangeLog hacker)
+#
+# The gist of this horror show is that the contributor list is piped
+# into texinfo-tabulate.awk with one name per line, sorted
+# alphabetically.
+#
+# Some special-case TeX-escaping of international characters.
+contributors.texi: ../ChangeLog Makefile texinfo-tabulate.awk
+	cat ../ChangeLog | \
+	sed -ne '/^[0-9]/{s/^[^ ]* *//; s/ *<.*//; p;}' | \
+	sort | \
+	uniq -c | \
+	sort -nr| \
+	sed -e 's/^[^A-Z]*//' | \
+	awk -f texinfo-tabulate.awk | \
+	sed -e "s/\o341/@'a/g" | \
+        sed -e "s/\o355/@'{@dotless{i}}/g" | \
+	sed -e "s/\o351/@'e/g" | \
+	sed -e "s/\o361/@~n/g" | \
+	sed -e 's/\o370/@o{}/g' \
+	> $@
+
+#.INTERMEDIATE: contributors.texi
+
+# Debian's install-info wants a --section argument.
+section := $(shell grep INFO-DIR-SECTION $(infofiles) | sed 's/INFO-DIR-SECTION //')
+install-info: slime.info
+	mkdir -p $(infodir)
+	$(INSTALL_CMD) $(infofiles) $(infodir)/$(infofiles)
+	@if (install-info --version && \
+		install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \
+		echo "install-info --info-dir=$(infodir) $(infodir)/$(infofiles)";\
+		install-info --info-dir="$(infodir)" "$(infodir)/$(infofiles)" || :;\
+	else \
+		echo "install-info --infodir=$(infodir) --section $(section) $(section) $(infodir)/$(infofiles)" && \
+		install-info --infodir="$(infodir)" --section $(section) ${section} "$(infodir)/$(infofiles)" || :; fi
+
+uninstall-info:
+	@if (install-info --version && \
+		install-info --version 2>&1 | sed 1q | grep -i -v debian) >/dev/null 2>&1; then \
+		echo "install-info --info-dir=$(infodir) --remove $(infodir)/$(infofiles)";\
+		install-info --info-dir="$(infodir)" --remove "$(infodir)/$(infofiles)" || :;\
+	else \
+		echo "install-info --infodir=$(infodir) --remove $(infodir)/$(infofiles)";\
+		install-info --infodir="$(infodir)" --remove "$(infodir)/$(infofiles)" || :; fi
+	rm -f $(infodir)/$(infofiles)
+
+clean:
+	rm -f contributors.texi
+	rm -f slime.{aux,cp,cps,fn,fns,ky,kys,log,pg,tmp,toc,tp,vr,vrs}
+	rm -f slime.{info,pdf,dvi,ps,html}
+	rm -rf html

Added: branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.pdf
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.pdf
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/slime-refcard.tex	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,123 @@
+\documentclass[a4paper,10pt]{article}
+
+\usepackage{textcomp}
+\usepackage{fullpage}
+\pagestyle{empty}
+
+
+\newcommand{\group}[1]{\bigskip\par\noindent\textbf{\large#1}\medskip}
+\newcommand{\subgroup}[1]{\medskip\par\noindent\textbf{#1}\smallskip}
+\newcommand{\key}[2]{\par\noindent\textbf{#1}\hfill{#2}}
+\newcommand{\meta}[1]{\textlangle{#1}\textrangle}
+
+\begin{document}
+
+\twocolumn[\LARGE\centering{SLIME Quick Reference Card}\vskip1cm]
+
+\group{Getting help in Emacs}
+
+\key{C-h \meta{key}}{describe function bound to \meta{key}}
+\key{C-h b}{list the current key-bindings for the focus buffer}
+\key{C-h m}{describe mode}
+\key{C-h l}{shows the keys you have pressed}
+\key{\meta{key} l}{what starts with \meta{key}}
+
+\group{Programming}
+
+\subgroup{Completion}
+
+\key{M-tab, C-c C-i, C-M-i}{complete symbol}
+\key{C-c C-s}{complete form}
+\key{C-c M-i}{fuzzy complete symbol}
+
+\subgroup{Closure}
+
+\key{C-c C-q}{close parens at point}
+\key{C-]}{cl}{close all sexp}
+
+\subgroup{Indentation}
+
+\key{C-c M-q}{reindent defun}
+\key{C-M-q}{indent sexp}
+
+\subgroup{Documentation}
+
+\key{spc}{insert a space, display argument list}
+\key{C-c C-d d}{describe symbol}
+\key{C-c C-f}{describe function}
+\key{C-c C-d a}{apropos search for regexp}
+\key{C-c C-d z}{apropos with internal symbols}
+\key{C-c C-d p}{apropos in package}
+\key{C-c C-d h}{hyperspec lookup}
+\key{C-c C-d ~}{format character hyperspec lookup}
+
+
+\subgroup{Cross reference}
+
+\key{C-c C-w c}{show function callers}
+\key{C-c C-w r}{show references to global variable}
+\key{C-c C-w b}{show bindings of a global variable}
+\key{C-c C-w s}{show assignments to a global variable}
+\key{C-c C-w m}{show expansions of a macro}
+\key{C-c \textless}{list callers of a function}
+\key{C-c \textgreater}{list callees of a function}
+
+\subgroup{Finding definitions}
+
+\key{M-.}{edit definition}
+\key{M-, or M-*}{pop definition stack}
+\key{C-x 4 .}{edit definition in other window}
+\key{C-x 5 .}{edit definition in other frame}
+
+\newpage
+
+\subgroup{Macro expansion commands}
+
+\key{C-c C-m or C-c RET}{macroexpand-1}
+\key{C-c C-m}{macroexpand-all}
+\key{C-c C-t}{toggle tracing of the function at point}
+
+\subgroup{Disassembly}
+
+\key{C-c M-d}{disassemble function definition}
+
+\group{Compilation}
+
+\key{C-c C-c}{compile defun}
+\key{C-c C-y}{call defun}
+\key{C-c C-k}{compile and load file}
+\key{C-c M-k}{compile file}
+\key{C-c C-l}{load file}
+\key{C-c C-z}{switch to output buffer}
+\key{M-n}{next note}
+\key{M-p}{previous note}
+\key{C-c M-c}{remove notes}
+
+\group{Evaluation}
+
+\key{C-M-x}{eval defun}
+\key{C-x C-e}{eval last expression}
+\key{C-c C-p}{eval \& pretty print last expression}
+\key{C-c C-r}{eval region}
+\key{C-x M-e}{eval last expression, display output}
+\key{C-c :}{interactive eval}
+\key{C-c E}{edit value}
+\key{C-c C-u}{undefine function}
+
+\group{Abort/Recovery}
+
+\key{C-c C-b}{interrupt (send SIGINT)}
+\key{C-c \~}{sync the current package and working directory}
+\key{C-c M-p}{set package in REPL}
+
+\group{Inspector}
+
+\key{C-c I}{inspect (from minibuffer)}
+\key{ret}{operate on point}
+\key{d}{describe}
+\key{l}{pop}
+\key{n}{next}
+\key{q}{quit}
+\key{M-ret}{copy down}
+
+\end{document}

Added: branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/slime-small.eps	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,995 @@
+%!PS-Adobe-3.0 EPSF-3.0
+%%Creator: GIMP PostScript file plugin V 1.17 by Peter Kirchgessner
+%%Title: slime-small.eps
+%%CreationDate: Tue Nov 14 18:44:25 2006
+%%DocumentData: Clean7Bit
+%%LanguageLevel: 2
+%%Pages: 1
+%%BoundingBox: 0 0 252 104
+%%EndComments
+%%BeginProlog
+% Use own dictionary to avoid conflicts
+10 dict begin
+%%EndProlog
+%%Page: 1 1
+% Translate for offset
+0 0 translate
+% Translate to begin of first scanline
+0 103.29540259080517 translate
+251.14960629921259 -103.29540259080517 scale
+% Image geometry
+248 102 8
+% Transformation matrix
+[ 248 0 0 102 0 0 ]
+% Strings to hold RGB-samples per scanline
+/rstr 248 string def
+/gstr 248 string def
+/bstr 248 string def
+{currentfile /ASCII85Decode filter /RunLengthDecode filter rstr readstring pop}
+{currentfile /ASCII85Decode filter /RunLengthDecode filter gstr readstring pop}
+{currentfile /ASCII85Decode filter /RunLengthDecode filter bstr readstring pop}
+true 3
+%%BeginData:        57552 ASCII Bytes
+colorimage
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcDnQp&=1TJ,~>
+JcDnQp&=1TJ,~>
+JcDnQp&=1TJ,~>
+JcE=]rVd0(rr2loqtg-`p\+IV#PRoeq>:*grpKf:~>
+JcE=]rVd0(rr2loqtg-`p\+IV#PRoeq>:*grpKf:~>
+JcE=]rVd0(rr2loqtg-`p\+IV#PRoeq>:*grpKf:~>
+^&S*2K`;\ar;-0]p at n@Wp at RnBl/gp^gtM_[%,0ImiT04hnFZMQrVl?eJ,~>
+^&S*2K`;\ar;-0]p at n@Wp at RnBl/gp^gtM_[%,0ImiT04hnFZMQrVl?eJ,~>
+^&S*2K`;\ar;-0]p at n@Wp at RnBl/gp^gtM_[%,0ImiT04hnFZMQrVl?eJ,~>
+_#FK8r;$?d!r;cn\,QX2rVZTlrpKdkrquWgqYU6joD]L&q=<e0hVR5Pj58P;ahkZtYGnAsUCF&u
+Xg>RRajSr)m.C/Qo)F4~>
+_#FK8r;$?d!r;cn\,QX2rVZTlrpKdkrquWgqYU6joD]L&q=<e0hVR5Pj58P;ahkZtYGnAsUCF&u
+Xg>RRajSr)m.C/Qo)F4~>
+_#FK8r;$?d!r;cn\,QX2rVZTlrpKdkrquWgqYU6joD]L&q=<e0hVR5Pj58P;ahkZtYGnAsUCF&u
+Xg>RRajSr)m.C/Qo)F4~>
+_>al?q!dM,hr<khq#'=Ts8E&tr;?HlqY^3lr;HTmrp0RjrquQ`naQ,CqYg!b$NBttna#E'me-GU
+p&>['q!?_R[B6U<\@8]>TW+a/a2[rL%+WD>YGn1p]$&prp\j^`J,~>
+_>al?q!dM,hr<khq#'=Ts8E&tr;?HlqY^3lr;HTmrp0RjrquQ`naQ,CqYg!b$NBttna#E'me-GU
+p&>['q!?_R[B6U<\@8]>SYMdk^:j at 0%*ZE"VkT`^]$&prp\j^`J,~>
+_>al?q!dM,hr<khq#'=Ts8E&tr;?HlqY^3lr;HTmrp0RjrquQ`naQ,CqYg!b$NBttna#E'me-GU
+p&>['q!?_R[B6U<\@8]>V6mGObffhD%+WSI]!S?7]$&prp\j^`J,~>
+h>[WWrVZQgrV-NkqY^<ko`#?tp?:)F[BI!Uf')i*lMh(eqtTjUnF$;Brp0RM%di]RoCV_Lp\=R\
+qu$Elo)B*rq=<_'da6P&m.UALrs\o'o&\EB_8O^YmeHbTrs\o'mFAPViU?6RSZ0Nnmg%djUU8G5
+p\jaaJ,~>
+h>[WWrVZQgrV-NkqY^<ko`#?tp?:)F[BI!Uf')i*lMh(eqtTjUnF$;Brp0RM%di]RoCV_Lp\=R\
+qu$Elo)B*rq=<_'da6P&m.UALrs\o'o&\EB_8O^YmeHbTrs\o'mFAPNg$@t9Q_M(XlNc+VT=!#1
+p\jaaJ,~>
+h>[WWrVZQgrV-NkqY^<ko`#?tp?:)F[BI!Uf')i*lMh(eqtTjUnF$;Brp0RM%di]RoCV_Lp\=R\
+qu$Elo)B*rq=<_'da6P&m.UALrs\o'o&\EB_8O^YmeHbTrrrDumFAP[rlbJ^Vm=2*bQc%f[*e.4
+rUg,?~>
+i;XMjrVH<]nEfB#j5]4`lgOH>q>C3jq>Us'pZTo*]]&><]WTQDp\jIY$N0Yek2"S6bK.`Erl4rX
+&]r8De_&U3i8`tbmIBiCqYgEerser%mFoFYYH=n8d,t$!pAYX%qXE=XWP-?nW4LRHq>U0h%/ohS
+[aX<je^`UCkMY^W#he/'d]LsbqYp0fJ,~>
+i;XMjrVH<]nEfB#j5]4`lgOH>q>C3jq>Us'pZTo'Ze=ZtZ`DC8p\jIY$N0Yek2"S6bK.`Erl4rX
+&]r8De_&U3i8`tbmIBiCqYgEerser%mFoFYWMcZ'd,t$!pAYX%qXE=XVR4(PUUo%Cq>U0h%/ohS
+[`n%#kND*rlfmd!#jCO?bH'(YqYp0fJ,~>
+i;XMjrVH<]nEfB#j5]4`lgOH>q>C3jq>UWspZTo0_>_X^_6_GNp\jIY$N0Yek2"S6bK.`Erl4rX
+&]r8De_&U3i8`tbmIBiCqYgEerser%mFoFY\[SrTd,t$!pAYX%qXE=XXhr)uZ+ANQq>U0h%/ohS
+[`cFp[C*Zc_S#6C#e.Ieb-TO`qYp0fJ,~>
+ir9kpr:omMj4hu'_7R1c\\?)/fAPl]p%eObqu70'nC=YujOr):jPR)inGDVQ#lOAYeA&,YUT+6j
+rMKRl&ZM at nU8Fur\%T]%dFmOFo_SR^rt#,*mFJYMn*93*d]1LSp\jjd&,YqR];b5Zi8F"CZIeRB
+rqZR'qsDY1lH-<4XLlTm]<(D##dM"dh:&pnpAO[aJ,~>
+ir9kpr:omMj4hu'_7R1c\\?)/fAPl]p%eObqu70'nC=SolKIEplJ&AinGDVQ#lOAYeA&,YT;)+R
+&tu(iSt`*_Z+%Eab0eo%lh(&Qq#:m(qX)k at WpB$<mE;ENkkG&Mrt#"th7KHKlKRR#^9ZAZqu6Ek%
+/]G:VsNL&hr!DRj5K@^#iO\'l-$WrpAO[aJ,~>
+ir9kpr:omMj4hu'_7R1c\\?)/fAPl]p%eObqu70'nC=kd^ULV[^W<b3nGDVQ$iK\\eA&,YXL#19
+Yl1d*YS+4IURn3WX0K.I_ogB[ip675rqQL(rqc$5[(=K"`5g$'bNS^!p\td$o%gpab.kU%a2YF:
+n,*+[rsekmc*tWnTq at sSXfJ=km at FTWVQdYS\`*8\p&BO~>
+jSp5!r:odDfu^e(TW#$4`5KX*VPBrn_U.-&nbE%]rr3Q/q<,T+jM8%%Z,#G4_<:Xnn,E[lpZKc$
+a7&Kap$)PFrpL<S_o0']WM$/ubMVgcrqZR)r:8UMa62!paj&Z!WmpM7q#:p(p>j&hlI!DZ]?TEJ
+]]&S_qYq$(q<,Q6i4G)-M3+3lOR.f0N0'^WmB"n/r:U)?~>
+jSoYfr:odDfu^e(SYE!prk&ZETV&$d_U.-&nbE%]rr3Q/q<,T#lJgaZi8X%._<:Xnn,E[lpZKc"
+^?b+Po^)SC%GA>*Yb%S[Vmjk,nG<.[rt#%ugU4c]kN(^cl.W)cn,)n[&H2=`_5$AZio/kXlE\(]
+pAOjf%K?1d^qT'lg=Os1gtUQLf*L$_h<"%&f(&\2s*t~>
+jSoYfr:odDfu^e(V6RMKrko5ZYH4P+_U.-&nbE%]rr3Q/q<,T1^SmiuTr>`A_<:Xnn,E[lpZKc*
+`luZIou$jQrQG\e`4`=ZUo1]FhsgLAq>V!'o%URl_R6MJYe%o[eF3;0rt,/&jMA1 at ZDaXtYeRud
+iV*6Hrso&(kJ5*MVO*gCQ^<u(SF)jQS!TSJa0jLgr:U)?~>
+jo5bfq=3Rs^o=!Gi9omnrSSgZlL"&YYFr&9f&uZ$rr<#tp><.DeZ=^dN2tLtZ/>9Sn,E[jn'nDq
+i76B&ouR3]rm_J2i8E\]lL+,hXhEQ]r;-F*rqPZpWTqU,S"$+djLMq`p\t!g&GtqFVs_s0PE:m'
+dI*aUmeck\%0$%_\AdC<OF21uK7NrKs+:9-!/p]8re^Z,$@I,DJssdGY0lb:p&BO~>
+jo5bfq=3Rs^o<g:g$J(krTPHim-X,NVk(!.f&uZ$rr<#tp><. at kMOqDf\blXZ/>9Sn,E[jn'n>j
+l0%6kp#H,8roXCIl07L4liue!VnLpWr;-F*rqPZpU?psugt^`FlE\(_p\t!g#5dl<V!R7#rn7S5
+k3Sbfmeck\%0$%_\@h(bg="<qeC4EFs4%)#!8./%rn%2"$I[>KeD0-OVpY#3p&BO~>
+jo5bfq=3Rs^o=9Obf[l at rOa8f`5g*>\>6:Ff&uZ$rr<#tp><.![@`qYS"@%3Z/>9Sn,E[jn'nV`
+]X>/OorS5"rj<3E]Y)"t`6-<H\%UVgr;-F*rqPZpZc&u<Q^=/>^V at GAp\t!g&GtqFXNIi=QC!r.
+ZH9&lmeck\%0$%_\AZ%WQ`IKoUS[sjs.fUb!1WhPrgj(a$EL>7UR/+$\'a^Cp&BO~>
+kPl%kr:]F/_5=EomGQ[Fai+.i+Mc+De_oWYdBTXhhspRBs8DWFVsi0;M04ZUeaKEjp&4C[$3'b_
+^rPBFXK8,gRfK>bX:DMI]>2P1dFI(<^;T1/rql^-r:8L?i7YAoK7f#]eaK<anbi7`')q^i^q/UB
+PC at n.P/$(f]]Akequ7B0pYrX"i4G(uBk_L(Jr,SXR]EKoqRZ[,s-a:VNerU]aQg"Znbi([J,~>
+kPl%kr:]F/_5=0amHNisjQ$3t+QDJDkNV=!af25XhspRBs8DWFVsEO'f?`(+kNf&#p&4C[$3'b_
+^q]-mhr!8_g]641h[\T'iSrqZk3)!q[`%>'rql^-r:8L?g$%AHeC<+-kNeqonbi7`')q^i^p<7b
+g=+Kug>_D&]]Akequ7B0pYrWol/C at Eb0%rPeCWF0gu%#IqVhG2s4dt8g"4j2jQrnrnbi([J,~>
+kPl%kr:]F/_5=`da1SmeXfMDt+K2EH[CjB!agn at hhspRBs8DWFVp)Q at S@"iY[EPQ'p&4C[$3'b_
+^rO*bT:_SFQN3QTT+7QlVPpW!ZF.9^_o1^4rql^-r:8L?bdX:8USFBO[EPGsnbi7`')q^i^qd^`
+QDgj_QDhR4]]Akequ7B0pYrX!]V_$raiV93URdd=Q_'eBqPO7`s-F([R at Tn8Xi.d"nbi([J,~>
+kl21mqXW[jYG^=Ag!..6VONkLO<BaVTrblEdG=!DXM<]cr;Z`ffq\#dXGM(VX4?[6g%>74rsA]!
+iNr"'XGMdfon*7"reV,DOH>ZqS#39qeaKToo_n^f'E7jn`i87FRtGWtJssdGVoS*!rql^.rUo!M
+dG;6kH>.S]Z.\'7g%51>rtPJ-j0lna]9%DS>]54_X1HBne^`@Li;V:,a9oMeX/ii!jIG&urUp2@~>
+kl21mqXW[jYFsS7kiLd]hV?l`g)o,+hr3VXl0I$"^Ynb^s8DTCU[.+#f?`(+kNenro_n:Z$3'\X
+Zg6f3f at SRGe,\)!f)XJ&gAfq6hV[;Tl`Ak5rVZ[/rqbp"U?psreBH.dguRgqa6NO#qu7<-p"cgo
+l/C=Cb0\f!kh2rgoDSRd'`Rmf[_1k`g="-?bgbG*iT0(_kNMd,roa=Bs5F"8#3"t'QJM33p&BO~>
+kl21mqXW[jYHc<g\$2a'S<oN>QQVT\R\-IXZF[os[D1Ylr;Z`ffqZd!T:E9ZT!ce;g%>74rsA]!
+iNpb9T:DFFoqMMYrgXIfQ^=#)Q^j\C[EP`,o_n^f'E7jn`j3ObQ_V:/UR/+$YfH&*rql^.rUo!M
+ah"78Y0!r<Tsr7Fg%51>rtPJ-j0ln=VO+@*`4r(6Su/Wl[C*L?]`,>=XU:r#St;h"fsBN,rUp2@~>
+l2M=oqXE=XUVuHN`3H"tN/*%9rHo`:K8#/DQ);".g$5``lh^VZo[oo,eZ=UMM6#1qU=f,:nG`am
+pY`=FeZ=W(K)0BuF*2bUG^OmfK7er9R`Octe+*A6rtGA)i3^G\]9%DSBRGoQi5E+ap\t'i')_:K
+TC:=3M03<JKqQ]XUWr6(qu7W7puK!)i4G(uBlATlaOT56lL43!_SEt)_na(en,MY[i8)r6i9cK,
+lM:GPs*t~>
+l2M=oqXE=XTtKaUj5AbIf[eR$rR)h;eCE1)gYUoLkj57klh^VZo[oo(kMOn;fAGcWU=f,:nG`am
+pY`=BkMOnfeG at B%cHjndd*g at keC<($guRh$e+*A6rtGA)i3^/]iS)`&ajSo%l+FLbp\t'i')_:K
+TBk[tf?_"Pe_T?ST?Zg$qu7W7puJuul/C at Eb08AjjQGdom-Euj]!f)[]=,0Ili6;Yl0.<nl0Wu"
+lM:GPs*t~>
+l2M=oqXE=XWPl`aX.buKS"?COrMq'>US43EQ(4VM\&>c!lh^VZo[on^[@`trSY!75U=f,:nG`am
+pY`=#[@`ucU\_\;\$W<=Z)aq(USFENQ`\3:e+*A6rtGA)i3^G8VO+@*b,^o,]Yh5<p\t'i')_:K
+T?O^8S@$>KTpi4+XNg21qu79-puK!(]V_$rahOU;XgPg[`;[sb_8jX6_T0^rbl>Tg]XkMY]Z7S&
+lM:GPs*t~>
+lMhLrq<ltJU#+_LZ'C9%I!BpeJqs>^+GGDrH$k-tNg6m"n%.TTrr)KAU at 6X6M04ZUeaK6bo_n:Z
+#QFM[][>QDT_b)XJoCQl!b$#!r/(B(#,]f9YL;q<r;RH.n^X?%eZ=UM at q9eAZ.\'6g%>7?rtG7p
+aJ\=FRtGWaCk.ehkH;Ybq>U<l.fT8,^8^;6Q%3e)R`Od-_ip@!CNQauDmZliDJX'$Q(l+An*e,M
+I_bURo`'F~>
+lMhLrq<ltJSD*5gi7lo7da6CjeCOWN+P"uidF-Lpg"YHJlal0Prr)KAU?h""f?`(+kNekpo_n:Z
+#QFM[]ZKEsh>5n-eBIif!jg,#r7Cns#2\M/WRC;6r;RH.n^X?!kMOn;\\?GCi98jmg%>7?rtG7p
+aJ%t]gsjQFbL>5+l__M^q>U<l.fT8,^7X`OgXFBrguRh/]7l#@=_+^A?F7(F>Zt61LRbiolg)'+
+DS#K<o`'F~>
+lMhLrq<ltJWQ2ZRTp;+ at X0Jh)US%OV+JGR/Y,eCjR?aJRbdum1rr)KAU<L$;S@"iY[EPAto_n:Z
+#QFM[]Zds^Rei?OUV?ZF!li!Mr13e]#+W!@]$g*Gr;RH.n^X>W[@`tra2kNTTsr7Eg%>7?rtG7p
+aK`[cQ_V:6_PWU!_RIAFq>U<l(]O6n^:M1^Q)26jQ`\3B_RmL`Yd(C=[JmNDZa$a:]rT5tbfn2@
+]@Z]Qo`'F~>
+li.Xtq<lnDVsVmDRuDlBF+/n$Q("TLX!"((P)bBSJqBZ,i:488p\t-`fV7ibXGM(VX4?[5f_#.2
+rs&>ecA:l at c2,KfRt>Q`91rN.JsuV<rL*qfdI*[[oDSUe'Dh%9W9VKoK5Y"&F,-X?m[qkpr;?R/
+rqPQc\E(GhIVW)"I#tqt_mSLurqudGrqblrS*J+bK7]Q5lAK2SF*;eSL>RB+iSf03H[9p[_/X at p
+DfU)Zc27M4s*t~>
+li.Xtq<lnDT^Cn#gt:*&cI1:qgYCZbh]Ub1g=b*/eC<=5l0>_:p\t-`fV7]phq-3+hrj="f_#.2
+rs&>ec?\g at jne$EgsjQEBP=6deD0uZrS.V6k3SPhoDSUe'Dh%9U?psreBFepcIUk7m$uGkr;?R/
+rqPQcYNk-$e'"0$db<[E]X?bnrqudGrqblrOmM/aeC<:7m!_j6@:Wt`G2I%MiSeNdBkV*h_-^HL
+?!q8ia8>l.s*t~>
+li.Xtq<lnDYfF&HQ^ahV\>Z$jQ'\$?SfjJgQC4;9USF9T][XCLp\t-`fV6TtT:E9ZT!ce:f_#.2
+rs&>ecF_-+YkkI.Q_V:5]tMA!UR1nMrKd_YZH9E)oDSUe'Dh%9Z,Ec2UV=^e\=]:saeR5Or;?R/
+rqPQc]t^M3W5ZZsX-fcs_mSLurqudGrqblr[)B)5USF0X`3cMF\@]Gh_r&;IiShVh^q[Rp_7$_Q
+[(!`gjSSrKs*t~>
+m/Ie!qXE4IV<Z=&OFqdrIYWcWX2N*,rm`.9aM50aVOEsH]'dSQk5##To[oo,eZ=UMM6#1qU=f,:
+n,EUjp#:(\iU-L,$-AZgDd6OcJssdYec!PndFH75jS/ZPrtYP.jh&%`^ls4_=^5lsR`Ocj`9R3u
+rVmT1p"Z[sh6r>iB2rJdMm:snWnd:Gqu7Q1lG]=Zad[p7R`OcVDUX#aJV&sWK7ipmKDpH1JUls4
+I,97"J<87ZoDa=~>
+m/Ie!qXE4ITBt[rg=4Kndam%,hrEe[roYEcjPo.UhV?oBiU".jk5##To[oo(kMOn;fAGcWU=f,:
+n,EUjp#9G<g?nb'$09mkbbh5\eD0-_kPaHGk3'LOjS/ZPrtYP.jh%_]inDl)RAJ-WguRgo`9R3u
+rVmT1p"Z[ll/C=C`JhOXf\kuHWnd:Gqu8)@lG\tRjP887guRgS>gmJ+DfC7$EH1aIEH,r:Df4cS
+C>N]ADLg"2oDa=~>
+m/Ie!qXE4IYJdZ8Q_Uh#W1TWNSu]!!rj<lQXf/"dS<oS2VTI6#k5##To[on^[@`trSY!75U=f,:
+n,EUjp#<NtbfBRu$*BPh^;Rt)UR/+\[Jd33ZF.Q_jS/ZPrtYP.jh&4 at W0XC$_o0<bQ`\3/`9R3u
+rVmT1p"Z[k\tb[rahc''S"[=8Wnd:Gqu8)@lG^0LXd>fXQ`\3:ZdZe1`lH?uaN4,MaN2EB`l7/Y
+_;<#G`Qd]IoDa=~>
+m/IdtoA at 0XlH,`THuEqGM5I?$e`Z5crpLuslK$dOdE'DRea at b2med"^o[oo,eZ=UMM6#1qU=f,:
+n,F7(qso,XGH%U-Pbt7>Q)D`nK5Y[[R`NR_rU9^M"n&Y&\FBCnrtYM*hQG8^[Z5ZH<E<d\OLjAg
+\`EPbrVmT0n^F)ueZ=UM at o6]XM6#1qT[iW3qu73'lc,L\ad[p7R`OcYF6%rPKE[S=Kn]O*re:?)
+#l91+p4J!NP1K4(J,~>
+m/IdtoA at 0Qm,[!Rd`fq]fA>EIkNhL$rp(]om-<ftk2bUbkNlp1med"^o[oo(kMOn;fAGcWU=f,:
+n,F7(qsnN5B;D;XL7b&iO.YLgeBH.dguQG\rTjCJ"K/W4nGE.`(&dg^Y0-"fg!RctOic&*iT\"c
+jS8`QrtPD$e"5mghq-2bI^m_Uhrj<ueai\9rttUu`focMgsjj/jQqS/jD]-[F+aI5F8l1;F8p7d
+qJgNKEH-#Od.73e~>
+m/IdtoA at 0a`3#K"X1l?USXc:W[DKl(rlcM*`4rmkZE:75[E5l)med"^o[on^[@`trSY!75U=f,:
+n,F7(qsqV9['?sN]W\HKT!b\eUV=L<Q`\!;rQP5Y"j+Tfd.$r1rtYM*hQFu3URA:,_8=?qR&7O7
+\`EPbrVmT0n^F)R[@`tra1o[%SY!75T[iW3qu7N0lc-BOXd>fXQ`\3<\E(]Pai`!0b0'__rQ>/^
+#l;W`p;k=sd-^E(J,~>
+mJf3GpufYlmEM>YF(oQ8M6#%Sma%ntS"+2]Kp9'nn*]K+mGF7PjS&QPrUea:n("LrFc!0Ln"SJ,
+rU0\3rqh:sLXXIiFiM79Q&Y(NRtH<]aQe[mBPM7MQBd`$HZRi\q>U<l(&d^SU at 6X6M03<*<+^E9
+[b]?6hY-sIrtP=qa/A4ERtGWa9jVgnTZukucL:Z-rt"tl`guD:RtH<]aQf"3l at f.j"dAt?L&_2M
+K`h@/L&V(*!L)+*s*t~>
+mJe4+pufYhmH*0ScH=AWfAG`Rm)YrVR at I?IG(m-?li-5fmFmD,jS&QPrUea:lf[0Wce%(;l_<&(
+rU0\3rqgYOGLOcGA&c>kQ%//]gsjj/jQq=l<`iImLkgbBC15c3q>U<l(&d^SU?h""f?_!VMT!oq
+iTSCdhY-sIrtP=qa.Ve[gsjQFDQD%4h<"$qcL:Z-rt"tl`focMgsjj/jQqV2l>llF"bZhrF8u:;
+Es)G`F8l/[!JAbis*t~>
+mJf3GpufYta0;#+\&lClSY!-paiCa#Tq&9S\@]DsbfRfAa3)0.jS&QPrUea:bdF(5[%3erbbEb^
+rU0\3rqjaS`7)rA]#MRoQ*nQ4Q_U=BXi.TFXfnps^:h4p\%()Kq>U<l(&d^SU<L$;S@$>O_9&jJ
+UUnOLhY-sIrtP=qa0ERbQ_V:6]u at UWR]si4cL:Z-rt"tl`jWgfQ_U=BXi.l`lH0%J"jm:lb5_M=
+aoh[db5VC_!RU6)s*t~>
+mJf3DnC=Jqfs-K\AT)sQX4?XAG&4^3cI7'eG'(<5CNukFWNp\qoDARfrUea:n("LrFc!0Ln"SJ,
+rU'V0re,obna:pXlK*8mYiNT`IY+$0lB,q,H$Rh^G'8(UIdkeaqu7E.m`hKnc(Ti2?VO at +Fc!0L
+n"\M+rVlg3rqGKa\E(GhIVW(Z>]54_aQfYBlh^MY&,PV3Sa+=dK7]Q5lBHGWK`6Z/PQ->js8VtM
+"94(/s8I]QPLf=)J,~>
+mJf3DnC=Jjkht+?^Wb-Xhrj@&AQlWScI6FSAR`5U=_FOdV6XWIoDARfrUea:lf[0Wce%(;l_<&(
+rU'V0rc<(0na::4lK)Z\V<['oe(!16m"8PRB4oY(A7T7bD",[Iqu7E.m`h?jjk\J3XDiQsce%(;
+l_E)'rVlg3rqGKaYNk-$e'".kV9IHEjQrPZlh^MY&,PV3PO.AceC<:7m"T$9ErL+`KE$"6s8Vt;
+"93F`s8I'?K@'2hJ,~>
+mJf3DnC=J]\"T:raM4dHT!c\TZ*LpOcI9MU]XbV[YdCdOZ*M!YoDARfrUea:bdF(5[%3erbbEb^
+rU'V0rlW=,na=B8lK,a^`4r7:W2#]]`4<4d^:r%.]=Y_j_slphqu7E.m`hfQYaV8s`P0+-[%3er
+bbNe]rVlg3rqGKa]t^M3W5ZZe`4r(6Xi.E_lh^MY&,PV3[`#;7USF0X`4W\Iao9Edd/V82s8Vu=
+"96Nds8L.Ad-^E(J,~>
+mf,?IpZ9/nkJWX9D/Xf`X4=@sDfpBeJ+)r[nUQ,NI!U%_GLYK!K)>QIs8DTBU at 6X6M04ZUeaK6b
+o_n.Vs+M8Pr;2/#q=B!@_;MqeI"e6<m?D^@JV!@iJ-1CUqpkTD(B40p_klY?RtGWa928l9LSiJe
+S^6d&rr3c4o\-=lh6r>iB2qN,Ck.ehkH)G]q>U<l&,PV3Sa+=dK7]Q5lBHGWK`6Z/PQ->js8VtM
+"94(/s8I]QPLf=)J,~>
+mf,?IpZ9/glf6aKbfnMhhrgeI?"@X0D=@%7nSW4*C1q5)A^oRRE;TY7s8DTBU?h""f?`(+kNekp
+o_n.Vs)T97r;1MTq=A at .\*;l*dad18m=o(cDf>/aDJjB3EVn)ZrtbV1l,0+ZjP88/VJ(+WcIUk7
+m$c8hr;Q^3rUegDam%d;dD_&OT$,U;j6NPVkP>,Trt"tl`focMgsjj/jQqV2lZ2uG"bZhrF8u:;
+Es)G`F8u5\!JAbis*t~>
+mf,?IpZ90"_Q/ru_S<.=T!c;<[(F*6`:*9;n\rH._8!\/][YfVa8>l9s8DTBU<L$;S@"iY[EPAt
+o_n.Vs2lG1r;4UXq=DG0aLnC:X.buda1]%#`l at Pg`Poj;aSYB%rtbV1l,0[BXd>fs`P'"*\=]:s
+aeI,Mr;Q^3rUegDah"78Y0"Mm_nr:9X2;9ZkP>,Trt"tl`jWgfQ_U=BXi.l`lcK.K"jm:lb5_M=
+aoh[db5_I`!RU6)s*t~>
+mf+X3o%0etfs-K\Dg[YXeW=TiH[gYBK`(e%r.KauJqARBJFW;bK`:uN&H27RU at 6X6M04ZUeaK6b
+o_n.Vs+M8Qs8Re,rqCiK_;MqeI"e6<m=oh8KS9:$KE?l-f),I_rqPQb`Se at iHtcYO93cCeR`Ock
+`p<L#rtbM#c_'XQVMB5$:IS;tI#tqt`4+e%rqud,qWc%jlH,NJJssdGP]c;Fre1N>s+Q1,s8.KP
+s+Q1,re1B:f(/ik~>
+mf+X3o%0emkht+?bgP5(kCZrJBl.haEr>lWr,QiQEH#jbDt3L?F8l1=&H27RU?h""f?`(+kNekp
+o_n.Vs)T!/s8R.]rqC39\*;l*dad18m<<,ZEcV*VErU1]s3UZC(B4*i\\.1cg="-,;J)cLeD0-O
+T>p3nrr3c2n'@Njk2+\7ZZf6.ajSo%l+FLcq#:3k&,PS1PO.AceC<:7m"T$9ErL+`KE$"6s8Vt;
+"93F`s8I'?K@'2hJ,~>
+mf+X3o%0e`\"T:r^T3a![C*<O^r4:gao)+[r5m(UaN)<h`pr`Cb5VD?&H27RU<L$;S@"iY[EPAt
+o_n.Vs2l/)s8U6arqF:;aLnC:X.buda18k%aiXJZaoBKas6]^`(B4*i\\u.XQ`J6F]"GtrUR/+$
+YK#o)rr3c2n'@fPZCIMq`kK%$b,^o,]Yh5=q#:3k&,PS1[D]26USF0X`4W\Iao9Edd/V82s8Vu=
+"96Nds8L.Ad-^E(J,~>
+mf+U0lc?'jad[p$I#tqtNbs#iJqSgVL&_1,s+Q1,KnP-WK`(h'L&M#_rUea:n("LrFc!0Ln"SJ,
+rTsRaKbosQs+Q1+pO'9_i4G(uM6#1qBR#)]L&_%(!WUaJs"OHGhQOiT]9%DS=%5\^C4;>\jLDnc
+q>UEnq<,SskJWX9D-KS#<bQlB]&:H/htI'Jrt,2+l,0%Vad[p7R`OcYFmF_[Ka!\?Kn]R,qh5.P
+Kn]R+K`RCgo)F4~>
+mf+U0lc>gejP88/db<[EJQl`&E,p%!F8u8]s)W8]F)uC"Er>oXF8c+MrUea:lf[0Wce%(;l_<&(
+rTsRaEu0K/s)W8\pM7(Cl/C at EfAGcW<bH>kF8u,Y!WUODs"OHGhQONTiS)`&P#>DLbL5,(lEIta
+q>UEnq<,Sllf6aKbb&<?Oic&*iT[qWhtI'Jrt,2+l,/\NjP887guRgVA*\17Es73rF*%B]qf;l>
+F*%B\Ergp?o)F4~>
+mf+U0lc?BMXd>fsX-fcsZa.9^a2uL'b5_Las2rLab0%j(ao).\b5M>OrUea:bdF(5[%3erbbEb^
+rTsRaaqrG)s2rL`pVO5W]V_$rSY!75Y.hotb5_@]!WVQas"OHGhQOf/VO+@*_Rd at s`i,3%^V.>C
+q>UEnq<,T'_Q/ru_Sj*u_TJpHVS'aKhtI'Jrt,2+l,0pIXd>fXQ`\3=]'IK;ap$/lb0'baqoT$@
+b0'b`aoTlVo)F4~>
+n,FF-puK!)i4G(uI#tqtcXh3IJqSf2s+ULQL&Zj\s8I]Us+ULQKn]L*&H27RU$pO5M04ZUeaK6b
+o_n.Vs+M8Qs8Re,rq:`C^u2hdI#4oSmqI'!KSBI'K`V5)qu8AKo at Tl-eZ=UM at o5Z`<bQlB]&:K4
+i:m6NrUo'Q_r/.gHtcYO78RH9M6#1qVqUeArVmH.q<,M^lH,NJJssdGP]c;Fre1N>re6()rV_EL
+K*_7)KDU=UKp1*Ys*t~>
+n,FF-puJuul/C at Edb<[E`Dg;_E,p#@s)\5?F8p<&s8I'Cs)\5?F*%<[&H27RU$Ln!f?`(+kNekp
+o_n.Vs)T!/s8R.]rq:*1[cuc)db!C>lW at e=F*%BYErl<fqu8AKo at Tl)kMOn;\UHe?Oic&*iT[t\
+i:m6NrUo'Q]BS;.d`R_N:jfe!fAGcWVqUeArVmH.q<,MSm,ZsOeD0-OL1BOirc86qrc</ZrV^d:
+E<GuUEVo`V!JAbis*t~>
+n,FF-puK!(]V_$rX-fcsbH&1ka2uKHs2tBAb5]W,s8L.Es2tBAb0'\_&H27RU!0p:S@"iY[EPAt
+o_n.Vs2l/)s8U6arq=13aLnC:X.>iibceb$b0'b]aoVP0qu8AKo at Tk_[@`tra1o*p_TJpHVS'dP
+i:m6NrUo'Q_n;k5X3&5i]"c:mSY!75VqUeArVmH.q<,N!`3#B$UR/+$]XmFNrlPDkrlWC^rVak<
+a924YaSYtZ!RU6)s*t~>
+n,FF-p>2t1fs-K\I#tqt^1MM:JqJ`0qh4nGK`6[Zs8I]Us+ULQKn]L*&H24OTC:=3M04ZUeaK9d
+o_n.Vs+M8Qs8Re,rq1W<i7YAoG_rKOmqR0#KSBI'K`V5)qu8AJn'@TndAD\?@8BKa;Ik!0Z.\'6
+g at Y@Dr:/7.n("LrF^n9A78RH9M6#1qT%*?/rVn;FpuT-,i4G(uJssdGP]Z)?K7nl=pO\"ho7;FB
+Isuk,I=CR8K7oH>o)F4~>
+n,FF-p>2t*kht+?db<[EZrCOOE,fo=qf;W5F8g6%s8I'Cs)\5?F*%<[&H24OTBk[tf?`(+kNenr
+o_n.Vs)T!/s8R.]rq1!*f]_8Gd+ at 1<lW at h>F*%BYErl<fqu8AJn'@Kik2+\7ZZeT0K>,^bi98jm
+g at Y@Dr:/7.lf[0WcaeL::jfe!fAGcWT%*?/rVn;FpuT-$l/C at EeD0-OL19=cEH6&MpMk0Eo5AMa
+D/=%KCM`BWEH?cZo)F4~>
+n,FF-p>2sr\"T:rX-fcs`N6Yga2lBEqoSd7b5TQ+s8L.Es2tBAb0'\_&H24OT?O^8S@"iY[EPE!
+o_n.Vs2l/)s8U6arq4(,bdX:8Z(7Jobcee%b0'b]aoVP0qu8AJn'@cOZCIMq`kJmm^rWdMTsr7E
+g at Y@Dr:/7.bdF(5[)]qo]"c:mSY!75T%*?/rVn;FpuT-,]V_$rUR/+$]Xd4HaN;NKpW1DIo>\bg
+`5BLQ_Sbc]aNDlso)F4~>
+n,FF,p"QG6eZ=UMF,-X?h/I4SH[^Hom""TrK(X_Jq>Q$Nre:CPKn]L*&H)(IS+"n/M04`]g$klm
+p&47Ws+M8Qs8Re,rUkK6n("LrFc!0LmqR0#KSBI'K`V5)qu8AHlc,jfad[p$>Y at sb:h"R(X4?[/
+ddd87qWc%tlH,NJDd5q3787*.KqQ]XU!<$&rVn;FpuAj%i4G(uJssdGPB#B,It)p(iSJq6eTc7[
+FE2B2EHB?NItIULo)F4~>
+n,Fa5p"QG2kMOn;cIUk7fO.rqBl%X'lu)=`E:n3jq/ULsrcA,>F*%<[&H)(IS*T7pf?`+-kj,,"
+p&47Ws)T!/s8R.]rUjm%lf[0Wce%(;lW at h>F*%BYErl<fqu8AHlc,UajP88/VJ&%nI(7MShrj<q
+ddd87qWc%mm,ZsObbf'$:i<>Ye_T?SS^$U"rVmE-puAirl/C at EeD0-OKj`^8D&$l4iSJ;$eRi?%
+ at UWWR?X_/mD/oL#o)F4~>
+n,Fa5p"QFh[@`tr\=]:s`iQMZ^r++/m)AJba7[Npq8pb$rlY9 at b0'\_&H)(IS'8:4S@"cZ\'Lr*
+p&47Ws2l/)s8U6arUmt'bdF(5[%3erbcnk&b0'b]aoVP0qu8AHlc-0IXd>fs`P&[k^W3^PT!ce4
+ddd87qWc&(`3#B$^;[e#]"Q(pTpi4+Wm0u/rVmE-puAj%]V_$rUR/+$]=6Sp`"g20iSMB&e\/T+
+\[])X[^aPs`5qlDo)F4~>
+n,Fa5p"QG6eZ=UMA93O'dG9 at fDK9iAaEGnYHJ*XmjaVi5q1S_HKn]L*&H)"BU[?="Km\uni8L]k
+p&=:W(kn1Rs+Q1*oQm;$eZ=UMM6#1qC3kJbL&_%(!WUaKs"XNJk.J4b^ls4_=[u+a93cCeR`Ocm
+amAm&p>NEti4G(uBiePK<_H\9JssdGUr;QprVn;FpYrU!i4G(uJssdGOD;JJFE;K4Z`\,>Sp-Kc
+Pc_pC_T/`rGCK;:o)F4~>
+n,Fa5p"QG2kMOn;^<Y<dk1O`U>[V#NaCNWGB\@*7j_\pTq/ZH6F*%<[&H)"BTC(are^E11l.N)l
+p&=:W(it?0s)W8[oOt#ckMOn;fAGcW=D2YpF8u,Y!WUOEs"XNJk.Iq`inDl)R9F2aAu3`$guRgr
+amAm&p>NEll/C at Eb*&U2O_1H6eD0-OT#BpjrVn;FpYrTml/C at EeD0-OJQTV)@prcTZ`[K,SnEk6
+L8DPq\%\_FASq1fo)F4~>
+n,Fa5p"QFh[@`traL at e3ZH';S[(!TWaLfdI^Y-E=ji#0Zq8rU8b0'\_&H)"BX2hH5TrXQX][3\6
+p&=:W(s:5*s2rL_oY70F[@`trSY!75YeS6$b5_@]!WVQbs"XNJk.JCBW0XC$_n3Rh]YqR[Q`\33
+amAm&p>NEt]V_$rahl!:_S!h%UR/+$Y/KW%rVn;FpYrTu]V_$rUR/+$\$3Qb]"#5ZZ`^U/T!Z5F
+]X>\rai:`q]YsR2o)F4~>
+n,Fa6p>2t at eZ=UM at pjA5VU=eg_3:+KVj4$IC8Gcc]6/@Fk(*1&Kn]L*&Gtk;WTqTpK7&cli5)VS
+pAXCX(kn1Rs+Q1*oQm8#eZ=UMM6#1qC3kJbL&_%(!WUaKs"aTIi3L8Y]9%DS=%c at _8Qoq\Q,Mje
+^ZYCho%'Vpfs-K\AR&nkBNA5MIZhJ,\%Lhtrr2p5rqGBY`8J7hI"Ig.lAAo;Vj*CN`5KOlmf;eT
+l2^#Gi!/K*H[+r+rq$/?~>
+n,Fa6p>2t<kMOn;\['N3hWF4X[Y0BiTST51=J]5-]45Gek&9tjF*%<[&Gtk;U?psreC*(0l*mkR
+pAXCX(it?0s)W8[oOsubkMOn;fAGcW=D2YpF8u,Y!WUOEs"aTIi3KuZiS)`&P%K)R?_5HigZ.Ur
+^ZYCho%'Vikht+?^ST&uacVt6db<^GYIrulrr2p5rqGBY]BS;.da[(5m!MKmTSA/t]XtcSli$/M
+li$&Pm+H,cmEGS$s*t~>
+n,Fa6p>2sr[@`tra2YT\S?g2ZaLf*uZ+d9/YGJP3]=P\kk/R,lb0'\_&Gtk;Zc&u4UT9cZ]Z%)3
+pAXCX(s:5*s2rL_oY7-E[@`trSY!75YeS6$b5_@]!WVQbs"aTIi3L85VO+@*_S!Xr]YhU`Q)hd0
+^ZYCho%'V[\"T:raMc6.b/2'9W0XBs]tEJ%rr2p5rqGBY_n;k5X.u#``3Q/5Z+[ch`5BIkbQ,fb
+_uR[Q]EZ=!\@q:orq$/?~>
+n,F"!puK'(i4G(uBjP1gLSi>Li;Dj?mJZJ]_8V[aD81>TmXp2lrr3Q+m)Z*iad[p1OLjAdZJbKV
+lMhZas8Re,rUbE1n("LrFc!0LmqR0#KSBI'K`V5)r;SPNo at Tqufs-K\AQW2H>YA+2I#tqt_mA:p
+q!6%omEM>YEF3C,M0ru;BRGoQi5;n[p\t0l&,u=]ZGYV4OF1tuS&ssamJcANjSn*:eH""raT09X
+]*?C5d;e*jrU^&>~>
+n,F"!puK&rl/C at Eb,_hnf&#NPl29lJmJZ>Y[_7E.>ean1mW!:Hrr3Q+m)YjdjP885g>V;+ZJbKV
+lMhZQs8R.]rUactlf[0Wce%(;lW at h>F*%BYErl<fr;SPNo at Tqnkht+?^R1k-V.Yq4db<[E]<gGh
+q!6%kmH*0Sc)f%8f@%d'ajSo%l+=:\p\t0l&,u=]ZFfA[g="3pguRhfmJcGPlMg&Ik5aZDj8e6=
+i<JB,aC!lIrU^&>~>
+n,F"!puK'/]V_$rai29/T:E-p]_o\Ja8O3iaMkj"ZbO35m`<NLrr3Q+m)ZHMXd>f`R&7O8ZJbKV
+lMh[Is8U6arUdk!bdF(5[%3erbcnk&b0'b]aoVP0r;SPNo at Tq`\"T:raMYs:`4Wt0X-fcs_R&1o
+q!6&#a0;#+]#DgmSZBoMb,^o,]Y_#6p\t0l&,u=]ZGX>PQ`IiqQ`\3Ma8X!W^](nF[/dN3XT5F#
+V?X06bdQHlrU^&>~>
+mf*jpm*(7Pc(Ti:EGB$*LS:ubr5er`rRLr+*U<(NY'IS+IY.Irs8Vr]`i&+DRtH*M]&:E3iV3?6
+rtC+bo[oo,eZ=UMM6#1qC3kJbL&_()s8N)Mr;SPLn'@TndAD\?@9dDeDd61NGDi`Zi25/to]!Ek
+jM6t.CN"T^X,q^BA9Ws:g#/jap&4mi&,u:[YJ];1OF1b\Jt'm4c2Pfb_#CtFX8o-sRfJ`PO9VB&
+m>BH;r:Br=~>
+mf*jpm*'_Ajk\J7c-*iHf%o9Cr8[k>rTF4Fs6L]XVJ3ThCiK:Ns8Vr]`h;\Zgsjd+iT[kZiV3?6
+rtBJPo[oo(kMOn;fAGcW=D2YpF8u/Zs8N)Gr;SPLn'@Kik2+\7Z_bUdbb]s+d+I:?fr!Emo]!Eb
+lJgOHbKSDghqHN$^<kNjkh2rip&4mi&,u:[YI`uWg="-feD0-Jjo4<@ir7p9hZ2O4g]6+-g'6Bp
+m<[=%r:Br=~>
+mf*jpm**&]YaV8g]>hq$Ssl at Mr2ft'rO)[<*Q6+E[^EZo_oMZRs8Vr]`j!C`Q_UUKVS'pUiV3?6
+rtEQRo[on^[@`trSY!75YeS6$b5_C^s8N)dr;SPLn'@cOZCIMq`l-!+^Vmq/Z(%GrbGNq_o]!Ep
+^SmHs`P8I at SsZS$aK_5.\'1i+p&4mi&,u:[YJRrLQ`J6BUR/*jYl:a)W;`[nT)bD\QN3<LQNin_
+a1Ts_r:Br=~>
+mf*jso\XW*i4kqFKmn5cF+oR7r0m\[rN-%2*Qc^^kO,mVFF<TSrr2c[`i&+DRtH*M]&:E3iV3?6
+rtL1co[oo,eZ=UMM6#1qC3kJbL&_2OL&_/Qf)>V)rqYfrV<Z0lK5Y",H&7,k>[VW.VU=h'cg:)O
+VVp.4N-K8gOLhF&OF1bbM6#1qT at EH0rr3N.p"ZS*fs-K\AR'/*S#i=_RfJZOOT((:L]2o+JGsp$
+JssdGQdEnQoDa=~>
+mf*jso\X#cl/LOPe^DghcILS$r7h;.rSRY6*TZAHlg1mP at qtN0rr2c[`h;\Zgsjd+iT[kZiV3?6
+rtKPQo[oo(kMOn;fAGcW=D2YpF8u:=F8u7?d/Eu#rqYfrT'YOneBFf.dFZmlV6S=shWF0ocg:)O
+VV11kf[.jjg>T*kg="-ifAGcWT at EH0rr3N.p"ZS#kht+?^ST0(gu$reh#5t+f)XD$e,[tsdKe:W
+jQq`M`;K6,J,~>
+mf*gro\[+"]Vq9eTr>6.\"T;gQN3KQTDtc/Xg5FQb.ja`_=7=#rqbs#Yf*Z1UT9cZ]Z.>;p\s=T
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drVn\Qq<>f"`3#B$^;\3sSYNp;`jhY2ZH8iem-`K&
+bdX:8Z+m?,VQH__X3.f?T!ce7eFNP:rt#,%goAT-Tpr=.`4i"5T:5bG!1*VNrgWt[rhBIiri6:!
+Q`\3 at d,Foos*t~>
+mf*aqqX/WG_W8tMTTY4eK)U/qK)gW(M>rYXS#3I/dH'5?Eng'ZrVGj"Vs;BnK7&cli5)eZp\s=T
+'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Os8N)MrVn\Qp>NEti4G(uC2\BXUmcmR>]54_aQfS<jQ=OV
+mEM>YEI<kZi.J;HOF2&%TZuktbjPB-rt#)$g8=>hXGM(0;-\$lM1tq]!.Oops)n<g!.b'#reUiJ
+c0C\FbP^u3J,~>
+mf*aqqX/!#\*E)6h:gN3eGdnoe,\%tfDjPFgtpuLk3CWD@,(/HrVGj"T^:apeC*(0l+"+Zp\s=T
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)GrVn\Qp>NEll/C at EbKSAebhU^lV9IHEjQrJTjQ=OQ
+mH*0Sc-k>)l$'>ig="6rh<"$pbjPB-rt#)$g8=3!hq-2bI\k9<f at BlM!7Uqqs3L\m!7UqsrmqA0
+jm7iQ`Vf?-J,~>
+mf*aqqX2)'ahP'TR[0G:U].=lUB%"dSGnipS>!!h^Wa6tg[G";qWl/*`3#B$X-fcs`jF_!roX4p
+b5LtbU<L$;S@"iY[EPkia3)R)s8C+?rrDHbs"jZJiO-S9VO+@'^TNurQ_V:5^S at -t`3-u<k/aLA
+YaV8sX-fcsWO/OhX1P'oYfEcfmed"`&,l1TVTcH?S@$>O`4i":U&LeeW;`jt[/R*+VZ*@iSHbFb
+`4sd\r:Br=~>
+mJd^qpj[O*\aA4t^TjH#OH>CuM#`>1K)U-<K85DNVSLmPQ+GfBqYBHsVWu9mK7&cli5)e[p\s=T
+'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Os8N)MrVo=bo%0_rfs-K\Dg at AOR%p.&DeON[]&:N6g"NpF
+jM6t.I#tqtnQ!<]]9%DlR`Oci_Wgprs8W&ifq\#dXGM(0;-\$^H2`3jJcLN(M>iS:Q2[6OWs60&
+oPWI0rU^&>~>
+mJd^qphaVJZ0gc:io&YJg=k3Wf)XD$eGdl:eCN:,hW!bdLUu=4qYBHsT^:apeC*(0l+"+[p\s=T
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)GrVo=bo%0_kkht+?bgG,&R&f#lbfS;eiT\"^g"Np=
+lJgOHdb<[El9quCiS)`0guRgm_Wgprs8W&ifq[lrhq-2bI\k97dJhSne,\%ufDaJ(g]$"-hZi',
+lWi5drU^&>~>
+mJd^qpr'kP^;mghW1fZHR$aB at SH,;]U].;7URms?S>`p;]t3%jqYBHsYJdQ0UT9cZ]Z.><p\s=T
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drVo=bo%0_]\"T:r^TO!"V5]fV^<3LDVS'gRg"NpK
+^SmHsX-fcse=4FiVO+?YQ`\3._Wgprs8W&ifqZd!T:E:/^VmmoY5YL$UB%"eSc4uVQ2[-LSd)(4
+gp>etrU^&>~>
+m/IRoK7A0UL=#>Kg!.UL]!;16!2faa+HVV=HujO_LQf!flD_V\p%[glVWu9mK7&cli5)e[p\s=T
+'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Os8N)MrVo=`mE;6kc(Ti2H&f>hKr2t]Jo>jkZ.\'2bfcd>
+fs-K\JssdG_-N&cad[p1OLjAg\E!A`s8W&ifV7ibXGM(0>]54NNrG.>RK0#[X8][1`;[jWeHXt!
+QZ_N>rq$/?~>
+m/IRoEG]?tGK9+9kiLmaiSaXk!8d_1+PPN"da$4gf%T'Dm%_DXp%[glT^:apeC*(0l+"+[p\s=T
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)GrVo=`mE;'fjk\J3dFmLBHCj3QeBH:li98jibfcd7
+kht+?eD0-O\4hD=jP885g>V;/\E!A`s8W&ifV7]phq-2bV9IH at g&B_)g]610hu;R7j8S-=k6C2<
+M.>bmrq$/?~>
+m/IRoaMbg%\]`%.\$3!3VP3pZ!1a%T+IJRhX1, at 1SsH(S`3R5?p%[glYJdQ0UT9cZ]Z.><p\s=T
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drVo=`mE;NMYaV8sY*l&rV6m at kUV="&Tsr7Abfcd*
+\"T:rUR/+$_kXWXXd>f`R&7O6\E!A`s8W&ifV6TtT:E:/`4r(<RJrTQQN3KRT)PSeX8]7#[0F:a
+^UiXmrq$/?~>
+li.EIK7Mg$DMG[ZmHWWfg&0A#dJh30]!eJtHt[A<IZ1/OhPJTcp$'GllH,NJI#tqt_6r:sroX4p
+L&LYrU at 6X6M04ZUeaI7!JqSjXs8 at ZOrrCXLs$m"_jh7eZ`0GjuNjdd5>E%jhRtGd;VU=h"]==F!
+c(Ti2JssdGS7RiJad[p.NjdcjXPNRJs8W&ifV.caXGM(0Dh=FY[f3l;a8jKaec+J,kPjcGmfg[e
+F+!T/o)F4~>
+li.E8EGjWC>^*F*mHj*%kksTDk5OHAi?$k0d`TeZe(EO>g8!$]p$'Gfm,ZsOdb<[E\@(>jroX4p
+F8ba`U?h""f?`(+kNc5`E-$+#s8@$=rrCFFs$cq^jh7MVj4i&1g#;/[97H6ggsjX#hWF0k]==6q
+jk\J3eD0-OQ;`J'jP884g#;/:XPNRJs8W&ifV.Wohq-2bbgbG*rSdb:!9O4CrojFKrp9XM"hf1j
+C at faAs*t~>
+li.F:aMm#I[(3loa2GX'\,<W6ZMpsKVPBZKX3/;gW10<_`i at DPp$'H!`3#B$X-fcs`jOh#roX4p
+b5LtbU<L$;S@"iY[EPkia3)R)s8C+?rrDHcs$m"_jh8(=X-KNaRA7 at AR'af6Q_V'_S?g8/]==]X
+YaV8sUR/+$V5h,FXd>fcRA7 at 7XPNRJs8W&ifV-NsT:E:/^S at -eU]..iXT5U)[Jmf=_Z%LQbQYtt
+\\[n'o)F4~>
+li7!=$\\/%HZm!"Um/^2i;E$Dmf)Joi8)elOF1bNCOVG]jLD\VnE7]clH,NJI#tqt_RAM"roX4p
+L&LYrU at 6X6M04ZUeaI7!JqSjXs8 at ZOrrCXLs$ltZgo\u[[Z5ZaQ,Mk5ARFoVXGM(OR`OceV4b6W
+^ls4rP/$)KPAFh!eZ=UMM6#1qT[iW2s8W&heXl6[XGM(<Jssd2h>Z at 3l2^5Nmgm:N_4m0YQCDZ,
+]Q\dTqpk9;J,~>
+li7!+$ZblVBk=lTT8'h`g&117llbQVk2G%Bb-T:>g>_D%\)6]<_k-5Ugsjd+iT[k\j7rW9rtKPQ
+o[oo(kMOn;fAGcW=D2YpF8u:=F8u7?d/O&7rUemIb3 at m<dF6k1lc3"#lf[0Wcd^b2m$X]CXm4p"
+e'ct0lKXR:;sWW(f?`(+kNeeko)/OfrU\R2lf[0WccjnojQGb+l2L#LmJcD^]!o/6KnbAP=^8UN
+CN'*ro)F4~>
+li7"-$H_qY^q at 7XXh;`qqof&^rkoql]!A3#X3/H$W0XBs]slngkJOI at Xd>f`R&7O9[c@/^k5Q.<
+rUea:bdF(5[%3erbcnk&b0'barQ>0?!:Bdc7fDu7Xi\/LRBEEPX2<2WV9H?>S@#&XXi.38TY%t;
+QDgaJW5$rJZ)Z$UT:E9ZT!ce8eaiY<s8DQ>T$4U7S@$&+Q`[[,rk/6K!6>)_&&H?.^q7:oS$963
+]Y_\cmIL:-~>
+li6s<2#W&YJE5FsFE)5 at ChmdZBqD8fTu#(Ci4G(uBjc";VU=h+cfjE(U?]jiK7K6*kJXplq#9FU
+'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Os8N)Mrr6C(n'RfrdAD\?KqQ]XTl+Jgh6r>iI#tqt_23g5
+eZ=UMKqQ]X\#XO`i7YAoG_Mg8m at _Yiqu?]on^<lpeZ=UMJssdGn'Ake_3:+KUM4MBY&A<#FEMfU
+H at 4h)JqX-So)F4~>
+li6s*2#VE5DWKN]@UNJQ>$4t$=.>q=S%$E(l/C at Eb-B7ChWF0tcfjE(SF#=leC314laaReq#9FU
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8N)Grr6C(n'R]mk2+\7e_T?SP[7>0l/C=Cdb<[E\VYt)
+kMOn;e_T?SYH)&5g$%AHd+-t6m at 2;dqu?]on^<llkMOn;eD0-Olc-NF[tTQlSl]'nY$PID at Uiut
+BPQXHEH;'*o)F4~>
+li6t,2#YM9`T5ar\[SrOZ*:I+Y+i57WlW?)]V_$rai:i_S?g88cfjE(X2M-,USa<W_TKFMq#9FU
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8N)drr6C(n'RuSZCIMqTpi4+^oONY\tb[rX-fcs^km]f
+[@`trTpi4+^8n`HbI=17Z([Vja/I2Kqu?]on^<lM[@`trUR/+$bf[cCaLf*uX0/\*Y-k^J\[oH%
+^VT$NaN=GKo)F4~>
+li6s<2#i8_K_Y2kIsud#H[:"iH-j`V^2IeN^Yl_cHtd>EP/$(g^YmtZ`Se at iI"Ig.lD;5Xq>TOV
+'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Os8QW\s8W)ol,0 at _ad[p&KqQ]XKQ_1:jM6t.GDi`ZheJ;=
+ad[p&KqQ]XT"oMd_r/.gI"7L#kH2M^q>UEkm`hftad[p7R`OcP@;2l`EH?5FcZsikhL'a#It3(>
+JqEcNKSBHWo)F4~>
+li6s*2#hW<Eqo:UD/=!3BkV23B at +h3^0Xs)[HZZ(d`Tb]g>_D'^YmtZ^$4M0da[(5m$YTNq>TOV
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8QWVs8W)ol,0+ZjP880e_T?SFCn^QlJgOHd+I:?fP6?2
+jP880e_T?SR_WK>]BS;.daQt2l_VAZq>UEkm`hQojP887guRgM:fsl,?t!PUcY$qGhJ6nCD/O:^
+E,kYnF*%B.o)F4~>
+li6t,+TKU,anYMj`5BI1^q[Y9^<k'7^9t24a1S:9X3&A[QDjet&E)EU`Or(7X.u#``4itKq>TOV
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8QWss8W)ol,0^CXd>fpTpi4+[^36X^SmHsZ(%Grb%dEa
+Xd>fpTpi4+VnfsO_n;k5X/;/__R at 5Bq>UEkm`i,WXd>fXQ`\34Vm!82\%'#]cb at 0KhSR.I`5Tad
+a2n%tb0'bOo)F4~>
+li6s<!<<%P#6+S\KS+o=rdlKhJai)WkBqQiBY`Q<OF1bfNjdckYLhI8`8J7hI"Ig.lB]<OqYoXW
+'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Os8Q*Ms8W)li3UA[]9%DfOLjB?BmjudlH,NJEJ:(1m;TS[
+TnRK8P/$):VU9^0\E(GhIXI6gi5;kXpAP!fm)c3kad[p7R`OcUD0FZ^IXZcsn:?2apAT^DKEM.*
+L&V(*!WUaAs*t~>
+li6s*!<<%>#6+SXEcH)Lrbs4VDt*13kA"YE<jq8Og="-kg#;/:YLhI8]]nD/da[(5m"rUDqYoXW
+'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=s8Q*Gs8W)li3U&[iS)`.g>V;]=)D<!m,ZsOc.1Y3m;0/k
+h:9cug>_DNVU9'aYj16%e'ct/l+=7YpAP!fm)c!gjP887guRgR>@lQ)Ci+$,n8E:=pAT(2EWc5\
+F8l/[!WUO;s*t~>
+li6t,!<<&@#6+SkaiMQJrl6AX`piE7kJ=mIY/e2PQ`J62RA7 at 8YLhI8`4Vt6X.u#``4<bLqYoXW
+'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?s8Q*ds8W)li3U>6VO+?aR&7OGY.D'T`3#B$]:k[ta*G"q
+R\@<kQDhRHVU</e]t^M3W2l;_]Y^u3pAP!fm)cNNXd>fXQ`\39ZFnr/_o0L4nA`NApAW/4aTMI`
+b5VC_!WVQXs*t~>
+li6s<!<<%Ps8N)[re2ebKnY3YK`(_#q1=1VF(X=_Z&EpMM6#1qU!D2o`8J7hI"Ig.lBfKTqW7_k
+L&LYrU at 6X6M04ZUeaI7!JqSjXs8 at ZOs&IYMs8;H=U[Qa7M04?6`95!TJotereZ=UMEJ:(1T$<s_
+EH?o4dI+ERhL0LDlH,NJFc!0Ln"\J)r;QQYa/A4ERtH<]aQet0II`$cq>,dBKS9@(qh51QKn]P\
+rr2uLo)F4~>
+li6s*!<<%>s8N)Wrc8'lrc9CaF8YoUq/L?3 at T;"Di7QE&fAGcWU!D2o]BS;.da[(5m#&dIqW7_k
+F8ba`U?h""f?`(+kNc5`E-$+#s8@$=s&IGGs8;H=U[.+#f?_q#j6O-YEb&8;kMOn;c.1Y3RH<8T
+c-Fnsk3T+ZhJ6Snm,ZsOce%(;l_E&%r;QQYa.Ve[gsjj/jQqS/C[uK?q>,.0F*%?[qf;o?F*%A&
+rr2uFo)F4~>
+li6t,!<<&@s8N)jrlP5frlQPcb5D.Yq8gS7\Z<r`Tpr<oSY!75U!D2o_n;k5X.u#``4<kPqW7_k
+b5LtbU<L$;S@"iY[EPkia3)R)s8C+?s&JIds8;H=UWg-<S@#/YX2<&d^UpYm[@`tr]:k[tT<OcX
+]""B&ZH:.uhSQh-`3#B$[%3erbbNb[r;QQYa0<LaQ_U=BXi.i]_XbeCq>/52b0'__qoT'Ab0'b,
+rr2uco)F4~>
+n,ELhr;-6gKE2#NL&_/QjSji5PQ$7^s+ULQL&Zj[nTo&VjM6t.EJ:(1mA%_LYf,J3OF2YKaQf/4
+lh]`C'SZMXfV7ibXGM(VX4?ZRH at gg(s8W%Or;T at cm)ksfc(Ti2KqQ]XUN2*7D9q%HNd>>XKqZbb
+KlLLALSiJeHctZ'GFn6MVMB5HTZuktbjG<,qWl/!lH,NJJssdGPf8.JL&V)UL&Zj\s8VtM!rmt.
+r;QcJo)F4~>
+n,EXlr;-50Ec_6ZF8u7?i;RctKDop<s)\5?F8p<%nRu.&lJgOHc.1Y3m at VGHYe0/Yg="L+jQqfE
+lh]`C'Qa6FfV7]phq-3+hrj<-BQ/$6s8W%=r;T at cm)kgbjk\J3e_T?SQ=+lK>KH'fg!Rd`e_T?C
+e]kAEf&#QUD9M0\AXi&KhU^!&h<"$objG<,qWl.om,ZsOeD0-OL;e$*F8l1CF8p<&s8Vt;!rm=_
+r;QcDo)F4~>
+n,EXlr;-62aiaV^b5_JAoDZl4d/M06s2tBAb5]W+n\;BI^SmHs]:k[ta/m>/Yf",NQ`HmJXi.fj
+lh]`C'[$CHfV6TtT:E9ZT!ceH^W4L>s8W&?r;T at cm)l9IYaV8sTpi4+_RIFsZHKhSRBFZDTpi3S
+Tt87RT:E4/Z-2CM]VEWTS=[3`R]si3bjG<,qWl/*`3#B$UR/+$]Z%hbb5VDEb5]W,s8Vu=!rpEc
+r;Qcao)F4~>
+nc'.!r:faIk^J&6q1OHUs8V0ZK`I>9KdHbQs8RfQKn]8LEKTP.RtGX2R`Ocm_U#F'i4G(uJssdG
+R)nXjjo6$KrUea:n("LrFc!0LmqR0#KSBI+rIt4M9)eVI]Xd+=PC at M*TZukXG)CZeZK/fbIVW80
+KqX3??Yk7X`95Tkg at 9`?VXN':M04?6`948;kP>)Qlc,jfad[p7R`OcY`ddi=rr3.Us+Q1,s8.KO
+s+Q1)rrCX at s*t~>
+nc&ppr:faIk\Y3Vq>PI8rrD!VEr^jlF!^j-s8R0?F*%(k?\Ie,gsjQtguRgr_U#Etl/C at EeD0-O
+Mob8]jo6$9rUea:lf[0Wce%(;lW at h>F*%B]rH%r;9)eVI]Wg\\g=+<sh<"$IA9r$!VX!0pe'"i;
+e_Sd#XNT)Ij6Oiug at 9)pVX*F&f?_q#j6NPVkP>)Qlc,UajP887guRgV`bkQnrr3.Cs)W8]s8-j=
+s)W8ZrrCF:s*t~>
+nc&ppr:faIketH\q>SP:rrDZiaoKffasI)1s8U7Ab0'Iq[^sDZQ_V9iQ`\32_U#F']V_$rUR/+$
+]#a77jo6%;rUea:bdF(5[%3erbcnk&b0'barQ>*=9)eVI]Y;.ZQDhEhR]siB]>qdt`kSI<W5Z`f
+Tph[d`PSL;X2</eg@<1tVTcH?S@#/YX2;<[kP>)Qlc-0IXd>fXQ`\3=`l._rrr3/Es2rLas80q?
+s2rL^rrDHWs*t~>
+nc'-soB+WF^iO[Fl at O\Cs8V0ZK`I>9KdHbQs8RfQKnT/JE09G-RtGX2R`Ock^s/sui4G(uKqQ]X
+R*+gnjSonlo[oo,eZ=UMM6#1qU=b'NL&_2OL&M$DrUo!KdG;6kH at 1gci:1T.N.5u(mEM>YEF3$l
+KlLI-F,-X?m]V!!p at Wg>`8J7hI!h$ei5;eUp&+[P`hr%CRtH<]aQf#0J,4lurrn,VKn]R,qh5+O
+Kn]I)!7p`@J,~>
+nc'-soB+WF^gUbfl>^ics8V$VEr^jlF!^j-s8R0?F*%%j?\@_+gsjQtguRgp^s/sll/C at Ee_T?S
+N6:PbjSonlo[oo(kMOn;fAGcWU=aF+F8u:=F8c,2rUo!Kb3 at m<dF-b-l0;DaI;NM<mH*0Sc)e"k
+e]k2#cIUk7m&+X\p at W1,]BS;.daHk.l+=1Vp&+[P`h;\Zgsjj/jQqW at D>J>QrrmKDF*%B]qf;i=
+F*%9Z!7:<:J,~>
+nc'-soB+WF^pq"llH%)is8V]iaoKffasI)1s8U7Ab0'Fp[^j>YQ_V9iQ`\31^s/st]V_$rTpi4+
+]ZTX=jSonlo[on^[@`trSY!75U=dN/b5_M?b5M?4rUo!Kah"78Y,dqe][X1"b/Cp%a0;#+]#DY"
+Tt84_\=]:sagnqCp at Z8._n;k5X/hVb]Y^o0p&+[P`im=_Q_U=BXi.ll`;7XUrrpRFb0'baqoT!?
+b0'Y^!:B at WJ,~>
+nc'-kiPqq)a2=clc$k7ts8V0ZK`I>9KdHbQs8RfQL&18gCp<!9PC at G%R`Ocl^rr^oi4G(uKqQ]X
+MU(\gjSoeio[oo,eZ=UMM6#1qU=b(rrr<"P!WRlPs%<4Ze"6$YXGM(MQ,Mk&Dg[UsH#)m!XGM(0
+;-n6L:1/-uVU=h(JaWC0I_`,L`0GjqM6#1qT[`N/qWl/!lH,NJJssdGPfA4LL&V)UL&Zj\s8VtM
+!rmt.r;QcJo)F4~>
+nc'-kiPqjt^:9S9c"q??s8V$VEr^jlF!^j-s8R0?F8G at U>,:HCg=+9qguRgq^rr^gl/C at Ee_T?S
+IEq<ZjSoeio[oo(kMOn;fAGcWU=aG`rr<">!WR6>s%<4Ze"5mghq-3'gZ.V.?#"k-B3FQ`hq-2b
+I]UeqFg96ChWF0pEUN\uCquq6j4i&/fAGcWT[`N/qWl.om,ZsOeD0-OL;n*,F8l1CF8p<&s8Vt;
+!rm=_r;QcDo)F4~>
+nc'-kiPr.7`lc6+c,7TEs8V]iaoKffasI)1s8U7Ab51SWZ,=>TQDhQnQ`\31^rr^o]V_$rTpi4+
+\'FI?jSoeio[on^[@`trSY!75U=dNbrr<#@!WU=@s%<4Ze"4dkT:E9cQ)hdF[)'u+^9GhhT:E:/
+^W!e'^;d[TS?g83^@(jm_n`auX-KNgSY!75T[`N/qWl/*`3#B$UR/+$]Z.ndb5VDEb5]W,s8Vu=
+!rpEcr;Qcao)F4~>
+nc'-^a04poi8EeVW-3ZCrVtsXK`I>9KdHbQs8RfNKC at U-F5>6 at LN@BcR`Oco`65"GeZ=UMM6#1q
+DU\.Rp&><sr;6?dqYU6jq>V90o[oo,eZ=UMM6#1qU"4elrVc_LL&Qf)s%<.Ra/A4ERtGX5TZul!
+F+3lVHuHjZ]9%DS=&!$r>&8_S`95UOL at kE@JBOYRc(Ti2JssdGW6"<#q<Q%ulH,NJJssdGPfA4L
+L&V)UL&Zj\s8VtM!rmt.r;QcJo)F4~>
+nc'-^a/J at jl07NeV.FL`rVtgTEr^jlF!^j-s8R0<EUV\pA(g#$f$;LhguRgt`65"CkMOn;fAGcW
+?ISHBp&><sr;6?dqYU6jq>V90o[oo(kMOn;fAGcWU"4/ZrVc_:F8g7Zs%<.Ra._k\gsjQuh<"$i
+@;P]2C0e=5iS)`&P&IF at T$,U;j6OjiG4b_0DTeR;jk\J3eD0-OU<)Zrq<Q%nm,ZsOeD0-OL;n*,
+F8l1CF8p<&s8Vt;!rm=_r;QcDo)F4~>
+nc'-^a10:/]Y),+XLuKmrVuKgaoKffasI)1s8U7>aR at orYf<u=T!uJ0Q`\35`65"$[@`trSY!75
+X4-V:p&><sr;6?dqYU6jq>V90o[on^[@`trSY!75U"76\rVc`<b5TQ^s%<.Ra0ERbQ_V9gR]siL
+\AS(6_6h:rVO+@*_S*q&_nr:9X2</a_t<m(`QP7$YaV8sUR/+$Z,l8,q<Q&)`3#B$UR/+$]Z.nd
+b5VDEb5]W,s8Vu=!rpEcr;Qcao)F4~>
+nc'9SXPhXI]=Z#7iG<diqYoQ0L&[A9KdHbQrqqE>IaturhU/3UF(T]X[b^G5bKQ^LeZ=UMM6#1q
+E7a^[q>V!)rVQEao'PZ(l0e6 at rVuorrb)3,n^X9#eZ=UMM6#1qS'QTTo^qg.K(aiorVlfkjh&%`
+^ls4eKqQ]XKm&"Cq0mFMlH,NJDd5q0:1/-uVU=h8^P_gcr.3Fnn("LrFafLgjL;_]p\F-qVs;Bn
+K7]Q5lBK;<qM"qK"blu1L&_2MK`_:.L&CrNf(/ik~>
+nc'9SWnHRqiSih\fii$+qYoDoF8pmlF!^j-rqpd,Ct6(]g#h/BcG\,`iTTQ_bKQ^HkMOn;fAGcW
+ at +Y#Kq>V!)rVQEao'PZ(l0e6 at rVuorrb)3,n^X8tkMOn;fAGcWS'PsBo^qfqE;";KrVlfkjh%_]
+inDl+e_T?SG%>Leq/'Sqm,ZsObbf&mFg96ChWF1&^O#\Sr,:/\lf[0WcdLP,lE at e[p\F-qT^:ap
+eC<:7m"WMsqK)Z9"`s]bF8u:;EruA_F8Z%<d.73e~>
+nc'9SZH9MTVP^E'bd+t%qYp*/b5]ifasI)1rqsk._pu;gaKh>-\&ke at UUnmMbKQ^)[@`trSY!75
+Xk31Cq>V!)rVQEao'PZ(l0e6 at rVuorrb)3,n^X8U[@`trSY!75S'T%Do^qgsa7dUOrVlfkjh&4@
+W0XBoTpi4+\@]`Vq8BhV`3#B$^;[e"^;d[TS?g8I^W6-Kr5R<^bdF(5[&B:h^V%/=p\F-qZ,Ec2
+USF0X`4X+.qTAg;"j6kfb5_M=ao_Ucb5D8>mIL:-~>
+nc*OK[-uPGOH>aGkFupAn+bmrL&R9iKnT>Up@*O`FJtS`dAD\?@;LIZ`95R;eBafVeZ=UMM6#1q
+ES:!_s8W)trVZNep@@V6hpffb^;J=Un+chXq=jUUo^V+fQg`J+M04ZUeaJ@(GLtL"fm7s at hL4ea
+qu$0FYL217Nd?)7]&<*nH%GnjJ9ZA-dAD\?@8BKj?uq+#dI*XPNVi_RK&3]Ii4G(uH&f>hd&Ypm
+q!?,$lH,NJJssdGPf/(JL&V)UL&Zj\s8VtM!rmt.r;QcJo)F4~>
+nc'9DXR#',g=k<Al]tjkn+ba\F8ggkF&i*Wp@)nN@]5OEk2+\7ZcghPj6OdNeBafRkMOn;fAGcW
+ at bLDPs8W)trVZNep@@V6hpffb^;J=Un+chXq=jUUo^V+fQg<hlf?`(+kNdu6A_5Se;qYhuhJ;NO
+qu$0FYKH+gg!S7%iT]W0B5d_FDe<\Lk2+\7ZZeTUZ-LqWk3SV`IJa$BESdn-l/C at EdFmLBafF1f
+q!?+sm,ZsOeD0-OKu at j)F8l1CF8p<&s8Vt;!rm=_r;QcDo)F4~>
+nc'9D^Wa*WQ^<u<_SNXqn+cFqb5Tceb#S>[p@,uP\Yu4BZCIMq`knU<X2<8heBaf3[@`trSY!75
+YM&RHs8W)trVZNep@@V6hpffb^;J=Un+chXq=jUUo^V+fQcuk0S@"iY[EOK:][tfg;q\q$hSS[Q
+qu$0FYK=ANRBETXVS(E^^;g*J`kAb%ZCIMq`kJmq`jhY2ZH8leb5;2:aPO,A]V_$rY*l&raK+(e
+q!?,-`3#B$UR/+$]>VYab5VDEb5]W,s8Vu=!rpEcr;Qcao)F4~>
+nc'9;b4!l]M0t)UdGB"cfBCk=p at j[JJoL1-hpQSFL!f;8VMB5$?uLXcaQfS"h9hk`eZ=UMOLjB?
+F4p-[qYBp[oC)#,hUTfaYbA&-`lG$ifB`%tki(=Mf[S$HJa_-jM04ZUeaI.-BVD/pUMFYIER*V8
+q"!(5n("LrFaT:^i4s2VK)PX-JpVC^h6r>iB2q?'Ck.ehkL-KfO8]+XKB9bOjM6t.F,-X?m\%qq
+p[6;,lH,NJJssdGP.uJ at K`:rSL&Qd[rr)_I"T*k*rVlfr!7p`@J,~>
+nc*F?_!C1 at f@&7,k1O9PfBC_'p at j)WE,b8_hpPr4Fis+6hU]uYZ-:_QjQr5-h9hk\kMOn;g>V;]
+A(gGKqYBp[oC)#,hUTfaYb at es]t^>SfB`%tki(=Mf[S$HJa;LVf?`(+kNcc;<hZ7^;kmK!X^KH7
+o(_e.V!I4$f?_n!iT[dUBlO%LE+rRtl/C=C`JdH]bL>5+lc?3`J,TEHETOj1lJgOHcIUk7m%)Ml
+p[6;%m,ZsOeD0-OKthI!F8l.BF8g6%rr)e:s)J8>EcV-Xrr2uFo)F4~>
+nc*F?cciegSZABQZH'5YfBDD<p at lhQa2dYehpT$6\&l[rS=[40`kS:8Xi/)kh9hk=[@`trR&7OG
+YhAUCqYBp[oC)#,hUTfaYbAD=`Q,6qfB`%tki(=Mf[S$HJ]tNoS@"iY[EN9?Y+_Sa;kpS%XgcU9
+o(_e.Us-6=S@#>aVS'sU^rQEPa2#%)\tb[rahbO*_PWU!_U,F?bl.S at aQ:(S^SmHs\=]:sae[;P
+p[6;5`3#B$UR/+$]>)8Yb5VADb5TQ+rr)f<s2bE at aiXM\rr2uco)F4~>
+nc*47am[c\M03lpVU=7AX2DYthr*F?He$BWZ(@3,mG6$aLN?m+F+Tk%lJl]gjO'LdeZ=UTOLjAd
+Ems7=lK at 0_f?_FIY+_Mj_scmOi8F"D[FF'`_m?><U7RUANp=`UK5YmhX4?t5=OF+bi:--\TC1+(
+LNA'9aQgZ_I=qOuK77j9kJWX9D-KS>F,-X?m\IV[OT,:[K^6^ElH,NJDh=G!lD2;\p at -Ohn("Lr
+IZhJ,YdAcGK(o!4K(X_Io^r*6$A!`qJ:[ChrVliJo)F4~>
+nc*47_!C1 at f?_anhWEL#X2DM_hr*F-C":JEZ(?]lmHN`hf$:UhcICY1m+PXHjO'L`kMOn>g>V;,
+ at ajQ-lK@0_f?_FIY+_>^]BehKl07TM[FF'`_m?><U7RU;M!X3XeBH7jhrjb"=NRAUi:--\SF#Cp
+f$;e#jQsB`CN9 at QEGT'Llf6aKbb&=KcIUk7m$>EKJc>]LEpLf%m,ZsObgbG/m%2)Xp at -Oblf[0W
+db<^GV6jt*E;0)"E:n0ho^r*$s)/22DK#4DrVliDo)F4~>
+nc*47cciegS[>kuS?g5>X2E2thr*G/^t$]GZ(AVMa1ALFT!u_W\>,Cm`7D3;jO'LA[@`tiR&7O3
+YLD_%lK at 0_f?_FIY+_f&_p$'6]Y);*[FF'`_m?><U7RUKQc-"mUV=++T!e:9=0]X#nEnSub-IP/
+\"f:l`6Ga-aSu1[_mmP"X-KNu`4X+"T:E4/_nY?Zrr<#?lc?cXXd>fsUR/+$Xhs;qnC+,U[@`tf
+QDhR:[(u.Np\+=$ouG,Fo_li1`X)"O`qB0+rr;BVs*t~>
+nc)Y-^$jLPM039KLSiJe[@<=qYHkHOCnR8m`:*!Ic*j=$F(&HcF+Tk%lBlY.kg#aedAD\HOLjAb
+CqIj4`P/a]U7J-idI6Jci75rb]=Z>NZ*V*B]]&eWs69m3RtGWa at WdO/pXLeMmB4Okk/aLdad[p$
+JssdGPB25+rr7Y%GB`K&VMB5$:LJ7!VU=gVcgHtqs!`WjdV81#XGM(IOLjAf[,CTIfTP^RXGM=d
+]&:>mFOtothV<G1H@"5rrd"rtG^%>TGi%`Xqu51;s*t~>
+nc)Y-[-Qo4f?^qOf&#QUXI"rNYHkH=>+h:S]BehJjl,%HcEjdccICY1m#,>akg#[ak2+\;g>V;*
+>eA/$`P/a]U77dYb3SH\l0%-eiSinaWjB@;[+YBCs6L$PgsjQF\BidapZF'kmAS+ek/a:`jP88/
+eD0-OKjnn=rr7"VAS1;khU]uYGHoHEhWF0;cgHDas!`!XdT>bthq-3&g>V;.[,CTIfSo.Zhq-<1
+iT[b>@b5APhV;huBP?&Nrb)[PAnB.sBAVqGqu4t5s*t~>
+nc)V,`lti^S[?GHT:E40\tl%*YHkI?ZCmnn_p$'1YbRYY\&QG.\>,Cm`4NS3kg#pFZCIMeR&7O2
+WOp<q`P/a]U8"j)aiqfB]X=l?VP^T7\[/rJ_>DIV`!EK3UV=^f[%3f_[4Ai/\&dXmaK`[cQ_V9i
+Q`\3<\\uSgs2i6mZc]SDT!u_R`jhY2ZH9H!ma(n4.EV)-Y0=;GS@#>aVS'gRi:QTmWQ_cBS?&$S
+]Z-GOf>6A$gq_UX^Y%3<^C.ch]Z[t%hWjb1rpB:VJ,~>
+nc'0HRIA\,M0398F,-X?jR)E^rkh(<i:$+!i75rXToOhJA861.LP`(^`-6OKlH?0lad[p1OLjA^
+?]1/JV6.\_n*]K%h:9cg]<%KcOH?p,d?'OMjOsI]s2bP9K5Y!k<+:!,pT,mRg#90eh7o`Mad[p$
+JssdGQ$.\2s8Rb(H>MNmZ&Ep=<,[AWaQh5lh=Qm0s!`WngMGg$Z&EpMM6#1qUt5&,hO2^G[Z5Zl
+Z.\#UAuBONY,Q33CMTZ=rb;gTBU>]aLpG1^o)&FWs*t~>
+nc)8.O6budf?^q3cIUk7lL!oX]">S_f^%njl0%-dh:^?(^<=gJf%8gB]k;&rlH>shjP885g>V;&
+:Q(I3T;B3Blg4!'l0%0giSWGig'?U#acM\=lKJ0/s5XI at eBFe;MR_!apYRL[kh32lh7oNIjP88/
+eD0-OLLb:Cs8R.ZBj03Ri7QDkMTjT*jQsunh=Q@!s!`$]gKN:oi7QE&fAGcWUt5&,hNQ%FiRuW2
+i98d6<2X!*Y,PR!=]qJnrE'D-LnfcOZHD.squ60dJ,~>
+nc)Y9[*5qLS[?GW\"B1r^W4R at _Sa:4bfn5J]X=l:R[KkYaMt`sT:MR]^pLo8lH?NPXd>f`R&7O.
+S;WW<YI29hbf[l=]!\cCVOs3 at Q^=JYaH2S/^UO-Ks/cQnUV=^^_8ipRpR`t2\'2).h7p)1Xd>fs
+UR/+$]t;8*s8U6^^p;1nTpr=._7ub3Xi/Yoh=T(ns#A0ngTo&4Tpr<oSY!75Ut5&,hQY27URA9S
+Tsr3dXJ`D/Y,SY#YcsjrYct=7XhV3W]<]T<o)&FWs*t~>
+nc'0VN6pChNd>MP?uq+#^s1EcrSSpRe^;LNXIG6(H?!kGIYWcWX4>"cJq))3aJeCGRtGX,OLsHM
+n,MYikMY1HdE024XJ(o at M1^8)MlYCsFL1&DZ2C^'RfS.[raGtABP;P_M(>%9lEJOb\AdC<OF22-
+X4?ZQG_(PJs+Q)REO4`APC@:PDh=G!lBHDSq31gX,),dNE5LPFOF2&%TZuktbO"i\Tu,a"OF282
+Z.\U7d)!W:p$_nF#4:BQ_rC at fo)F4~>
+nc'-UK#m38g!S!WZHh%XioTA$kp,ETk2bLYgtC6*c-4M^f%8d9kI7I4D92%aU?psreBH at piT^@-
+s6LTgl07BnjPo.Uh:pZ8eC2juhrj<IX6S^&r87P0!S#?m\-'[kaj9_5/)94PWm0/*^$4M0da-P&
+kNc2]DfYmXF)bu&WTrKse'"T3eD0-OL19BBKDtlpF8+[#\EVu+d`p=ujmAV^m.98,\*;l*da6Y)
+kj.QV[^s'Cli-5TmFnMViq<9 at s*t~>
+nc'0VZcp"URBFEJ`j_P0W3E\@rOaAa[Bcp3T9kt>Y.DBTW1TWNT!cJ9^r5@#aK`[cQ_V9qR&7Oq
+bl>Tu_S!IfZE:(#T:2%3S>3$`S"@%3FLf/bU&:P_QN<kqrl5,_b0%*cS1Br.`4=.E\Ac+XQ`IKa
+T!ceF]uJ1os2rF"[_okYQDhd@^S at -t`4WYEq9]-@,0KZ>[E#qWQ`I`lR]si4bO"i\\B2C\Q`IB\
+Tsr7iaN268p!!ER#04rt_rC at fo)F4~>
+nc'0cRtpCUVMftKDeO3IPG,(drOX;ZXJVJKM1^+oFaSdtP,>;-e\H%JMh9 at BaJeCGRtGWmI#tu>
+ec3`.`4NIZVONd0M1pJ-Fa&4bMne?DB^aKQN;SP4K)foiFT?^[Hn9lHdI+0[e?m0P]9%DfOLjB?
+CjL\ds8RfLJ9?_9c(Ti2A:Tr`kMg9&nbeUMruZskl#`9Wad[p$J<e(9Xha,ll)U*7ad[p$GDrfW
+e_U5_p!s&`#0kigWQso-o)F4~>
+nc'-bOa-9ThUp<(bfS/]g>1Zai?R:<hV?i:eBuOedaZn&hV[JY\6I:+EQd[hU?psreBH(`g>W%o
+s5Y$WiSi\NgtLH5e^Msmd*gFrip,fBlf[0Xr7Ctu!6tJg!7CJf/C`P=m&8(V[(PY^g="F'iT]W2
+BlJ.ns)\$SA:3e+h:9cae(`pKfii%Yr.G"K*cq2B at Z'O5gsjQsgZ.Us^ut at SV2"?tgsjQpf\krU
+rTX"<ro=:Fkj>1kmJ?DRJ,~>
+nc'0c_RddlS=?C\^WO$WQC=G at rMCg5T:D77S>36u[&]smQCOPP[D]AsaN3T2aK`[cQ_V:;X-]^_
+[K!?GX/;YaS<oP0S=ud[['?[,S#F*RB[!lVS,AfVUB%q)ZiI9%X":$9ZH9W!e?m0,VO+?aR&7OG
+Z,"E&s8U7<`OiS!YaV8saJP6'_UPj)nbgc5ru]D[l++ at CXd>fsVNn4![_V(ul,(-PXd>fsZ(%Gp
+[CZ at MosOe$#-bSWZ-Mb5o)F4~>
+nc'0mWH+9hdBSspJp_c`IYEW=rK&7_M2-_2FaSXiM3+1,^X:TgUi1MBOG)'LbGsjLRtGW]Bmc$A
+XT+b,Q&q#_LP(&%Fa8 at dLP_+]X2!`#EpqP[M>_f(J:`B,rJ:N7oT1T#dI*ONf!WHS]9%DhP/$(r
+Dg[1ks8RfNJU2A*eZ=UMFb#q%lD8QNp\pBUruZslmWXTVc(Ti2I#tqt_m\Rsn$RH/dAD\?A9a'7
+XLA,?orS.^#GJT^e%=]9rq$/?~>
+nc'0mT4!H at k2>"HeC)^he(*('rRrLKf at JI"cdL7kf at o$;io]FXT3Z'nJ9&m$bG=LcgsjQ8b0o#C
+huDIKgY1?4f$r0rcdC1jf%8X2hr<ptEpMoGfDX,"e'umtrRV&&o\(hPk3SD[f!W0TiS)`.g>_D0
+?>FP%s8R0<DeNVGkMOn;cdU\1m$V9up\ogEruQ7YmU^h6jk\J3db<[E]XHhln#pHlk2+\7^<kNi
+hu2O,hu;C9h;RS@]B&bdoDa=~>
+nc'0mcaUU+ZD!PQUT:Z/W1f`LrKeauS=ZLV[&^.#SX>b8W3WhNX0fS)c,o5;bHo-hQ_V:4b,^m.
+TDt5pQ'[o/Sti6e['$I)T:M at 9SuBEEEm1q`SGfJjVPBo[rLEqVoU%/!ZH9;rf!WH/VO+?^QDhR:
+[DL#-s8U7>`kS_$[@`tr[&01l`4rh"p\rP=ru]D\m_$$LYaV8sX-fcs_m\Rsn'&2^ZCIMqaK_5,
+T;2C_oq25M#F_F!b.Ha0rq$/?~>
+nc'*rZ?pShmb,O`RZNG_Jq3]F,(P8sLP_+UR]F$@e`?/&Uq_5+pQC6[nC"9&c(Ti0C1q:.re^Z-
+(k@![H$k-oLP_%QR\m-saOTA/FcG>4Z','I"-o=DT`(nk[e.-]aOSk7gYKK]i4G(uI\tN\]5rFR
+L&_1,re#WFZK/fbM2 at 86lJlo1Jc#J2rr4'orUY>Wi7YAoG_1dQeaKa"o^on;_Vi%fIWojXM2 at 8l
+OS+J0K*R76eaKa"pAX[`J,~>
+nc'*rW+fV4m-*KfgtLE3eC49B,1G&kf%8X0gu%)OkN_E1U;(AZpOdP4nC"*!jk\J2bK7lSrn%2"
+(Xpg[dF-Lnf%8U/gtprIjQGg]A<#:+i;D:2gYCT?rSR5*/*,m<RbQZ1^$4M0daI"7m'L5=EHD0[
+F8g/pC8^@Vg=Os0jQtT0B5d\IKDtlmF8b]EAD-2)f[/."hrj=0ht6QO?ao:Yg="?nd+?n&rn@%s
+rmV2)hrj=0htI'@s*t~>
+nc'*rftb&#ag\=EQ^F87USdmg,,V-1T:M at 8Q_((V[D0huWP?3epX%(KnC"P]YaV9#`lcH)rga"`
+(o=:9Y,eFpT:MC;Q^jYEXgPpcZ&Qu:TpGYE"-o4>Rf/fXU\(E6XgQ]ggYKK\]V_$rW1:08`4<h-
+b5_LarlDsc`kSI<SXl1N`7D-+`r#e_rr4(_rU[h0bdX:8Z(mk][EPl4o^p_Cah4L;W3Nk;S=H#H
+Qh?mJUBd?][EPl4pAX[`J,~>
+nc'*u\:Aq>T&AebaL\XRR[*`2+-i:`VQ7;CaOT56hQihocf9S/rKDrco\?(sfs-KfIf+R4J:`B,
+M2 at 7SQ("SN[^sQ-e_o`LZZC,kVru=>rON*LaN2X)eH"Fti%+*MXL%-P`i\FBQ&q*)dI*cSmt?Dp
+s+UK+J:`(7dC-*V[`Ia4I=?hJs-*H^+GKgiIXAK`^lsA%TXs(OZJbHOaEMptdAE(bLOsu&I!>7+
+!."Qk#_8APh=.W*pAX[`J,~>
+nc'*uY&A$fS([,kjPf%RgtV\Z*o#K*hV[;OjQGdofqt?Jcf8q`rI]1;o\>qhkht+CqpHG4eC<%#
+f at em4gtprIiT0.al0R*$@pcL1lfI.)i</-$jQ6@'!9j(>/*tuiXm"ldU[-spg=kEGm%J%[Ec_9\
+F8p8uEbXn&iSWPOjQrUXCiTISKDtljF8krNCT?[Zg=4X.iT]X5i:cr_ASLMnhV-W5eGdkrd.P]b
+dJhQ"e(ipGlEB+=rq$/?~>
+nc'*uho<IFU<UQaXeqe^Q^.E7+-i1ZS=ZUVXgPg[ai('bcf<$drQr^Ro\?Un\"T:dW;N\8VPBo[
+SXl19Q'\#4USb0![CjH"`NZeU^r!=SrMB[tXf\i+[/df1]IUqCZ-):l`kK<jQ'dr/ZH9)Zn&``P
+s2tA``P8k(ZD4"_UTMJ>]#2Vgs3UcF+Nj]Y_mm\#W0X3RR\maIZJbHOhn6A>ZCI5MT;/?cX0M?)
+!3Z=%#c<r`]$de>pAX[`J,~>
+nG`s0KRr(&CnoqRi7ZN!`;7%e`5p$Ie_oNRn&(E2ER0%"p4S/"PD.Q^kH_PW^oNoer/_k_R[TnM
+X1#UXaO/Poi9Kaf`2 at ZsK6u$j_sQO`hui0-lL"Q=!7:PW0Z1`C`58R!cc#GDeW'"E`4EP$e]#+I
+p4S/"s+UK+Jr+Q8mG6=Ch<MtfL4P$Xs-*B\*rCJ?JDS\YR[Tn\m`*$(q#&EcF-Z%<^TjZ)P)tc`
+on`[/rf at DNR^VM2]&`YcoDa=~>
+nG`s&Ec9mW>*dk.l0.9jj8.^Uj5f:`kNV9ulb&!^@*`TTp2Y6SK6,B6kH:lNinrPgg)Jf%gtglF
+iSihXk3(smm-NE<TjqMPC!p\*mHXZ7"7,=?mJZ>PaL8PS[kPG'\%K5IB@"<`n(!$Vk2YFZjQF7g
+C\Dgjs8R0?F)cJ7M!aEhkNM9I[WZS0s8R`Lru1cQF)p!si8!,DiU".jk4nkrCLN%ck2P=Uh#?"-
+f_*hrg&B\2gYCcSah$R.rq$/?~>
+nG`sVai<8[ZGFc']XP2KX88\8X0&M0[Cj8mbeq,t\'MnXp;tJWd)tbNkJ>0QW1K?Ar0SFgQ^=/4
+Sti0`Xg5 at G]Yqq6`3HPV^qeC+b/_9q]E?$h`5hi#!m&F&qoCJ.aN2<A[C"97oC(5:b-J(FVQI8B
+]#+0`b5_Las2rF&\\?+q[C*Ta_7%8$aoDCfr;Ri8`k]"&ZD!VOR\n3S^ZP=hk/+XB`3Q>8S<oP/
+R%*c>!1EhR#aLaO`7)<Yq#9mbJ,~>
+nG`s0KnT*^H#n&*_;ObHkPF*YkN_@#n%cGuC:&,:II;^`rIot*PD0&7n\fXgjOM>dr44>qaN2WV
+e_T0HlL+,e_53cF\As8ONIgDKEJV6G_84'kPc0=NC29cLDYe9*[;^)AF0C>achd at tO-f:ti8EnI
+Y18(!Kn]R,L&Zj[NdPo(dI6POQFPP*K8'@*PPkG%rI]rTRd/SIaN`Q/HID9ZrmQFFEL#tQg!RmU
+]"50>WrTU-\d-0pe`rLFm/$;QJ,~>
+nG`s&F)pp:B45;E\(L'6lh]iGli-5ilaF$Q=L;R[C[Q0<rH!&[K6.(jn\AeIlK at 6fr8B-cjQ,Fc
+kNM0rm-O&Y\"B1#\Ar`.I;eFo@!T)l\$s#HKqW]l=BVT(>[@550XY4nI:9*ulcK"sk(JTXlfm[#
+afa04qK$`Xs)\3]Edhb3Gf]4:aG@@XI;s?.s+C7L*rU))D2moGjQ,FdltXu;qu4iYBjZ\_lKIBk
+io/kSp##`,#NOn.m"rsQqXXZ:~>
+nG`sWb/s;>^::DQaNVcE_YUne_SjC7bf at E1YdD!X_X>J at rQ<:_d)uCdn^Fke^U:2Br2(sEXf\h8
+[CX#f`6$6HaKD;B\AuJ(b/Wba\%BGoaN2<-]<SoLYHXt,[']V9+Lel$_s?I]p?''(ahk^'`5o+3
+`qmj#s8U7Ab/qiC\@VX_#emh#b/ha*s3U]D*rX1#]"GtjXf\h=ag]^equ5m#^p^u!^ULMNW2?Gc
+opu/Yrh]q$XgQ*^bj>2ss*t~>
+nGa!1Kn]L#JUW9nEGTluXi^IV+/5QrTVZS?Fa;npNe at 4^s8Re,s-*K_rqY&rDmSotjS[pakN_@"
+n*eT=U6Kk;DK3VAL#_KZK9Co_NI5ug]5V`#^N at SAG^=\jh>)FPidH6JI`RTGec,I;SooCU`knis
+e*;SaKn]R,L&Zj\Ob%q)EGi"#G2;SJKSBI+PPbA#qi6GYXPrI0mEp6&k4eiSeV&L#F*Y(Lmcrlk
+i7[eR!8[Y4#NtC at V/kMdrUTu=~>
+nGa!'F*%<TDesR;?Wq*9VSrA at +-iFQSY]W*A7sh;IW>7+s8R.]s+C at OrqXo^?)[)UlMTlqlg4!*
+lg)U#Q%ipS>[PFrG2qn;EIr6+I;3B3]3epV^LG;rB4tu5h.le%0]Hk`P\e3dq9T';o9*TuR(g).
+?IS1ZrH!&[s)\3]F+J7FARJcI?Y&!\JTGo4s+C4K*W(;0CSoeOm-Vl.AENXbs3G_(Bjk_Rg$J(j
+l07F)k5a`Fkm-P at l^2,=o_n@\J,~>
+nGa!Xb0'\X`l#[7[^*9F[_DX[+2G%mV5:Q4]>!4AbK0S's8U6as3UfGrqYTi[)U>.^\k_n_SjC5
+bfn8O^qI(YZaRg!_rL(+aNr!'b/(d/]=,/Z^U_J!^;%G;h8/s)0]KsdcGSSaq<\+Xo?=eT_o9a+
+[F=E^rQ<:_s2tAab0J#D]XP8P[_(A`cH=<0s3UZC*W+$u\@0W"`5g*1]B8kds6[qJ^pphlbfRf<
+]Y(`H[/df;]Ec<lbepsKo_n@\J,~>
+nGa!1Kn]R+KS,<NI<p.[_5dEP'le<6G1,&kk(&$VKT_&hL&_1,L&[A9s#'c2N-]QCWj9IZ_nj9c
+Pa-upCMn*4Fa/4[IHp9^p\L&,PD0!uJq3+II=:5?J*hc;JqE[hq1C6nK7g1Vdus^]s8MnoIX-(P
+FO#7#pOrR#L&_1,s+Q/jKS"`'I,B@&o_Oc*rr2t^qu7]9OcG4<G*nVtE-Hd'r;ZfJKnP#*G]InN
+Pd8-Bi:ZOHcbRB9UR%s&I.7"3o)F4~>
+nGa$(F*%B\EcHQoCM at D&_5:T=?N4 at H@Dud*fkTYeDt\4'F8p=]s)W8]KDtm.rRuX4 at Afp!\%KA_
+]Tn2+GFhuC?=@>UBPM>Jmsk*.JocQcrdf$,l/c\rjl^LJDf9T6p%J3$/GO4)SoN#-rm:]Eqj_J8
+A&2X"C$kY9s)W8]s)\3]F+\LPDJX(FCMre at K6.%l!/(1K*WCV=GK=BRM5O]lD"RZ*s3Ph-Deirn
+AS?gq\%:5blO1bA\%S)`X(,o6qYp'cJ,~>
+nGa$Yb0'b`aiMZk_SEk,_7@#R[K!ZL\Ac).ftlgi`qIO#b5]Was2rLad/O&&rU%_A\>Q[PaMYp:
+`5'!u\Xp(4[CEf]^VRePn'(P&ccXVWrm&R(l/fe!jlaSL`l?'>p%J4&/GR<-fZ<@)rpBabqpr[!
+]"tr&_!Um=s2rLas2tAab0\8N`P]OL_Su0Dd)u at f!7:WC*<+7,`5o:#^U1G^_t<m,s6[tN`koF!
+ZF%<aaMRSn$d6T3`500g]#!n4rpp)>~>
+nGa!1Kn]R,KnY]dK7\[@kg'*Ss*bXHJFW8`q1OG#Kp.5jL&_1,L&[A8s"<;nJUZ7pF)eXrE4U+4
+Fa)>]I!pHoJV&K+qYZNUs-&/#L&[?iK_kIrKD>7qqu26ML&V)IKc'iDKs$-\PQ056s8K*PJUcm5
+mXk<6L&Zl+rt'naKnY_EKS4u1pOe.trf`'8rrA8ZruI;cO6MFEGh%1lK)GWJs42mXKS+f(L3Ri]
+E3X7rrbE. at C20K<CMRa'DfE:/bh7GsqYp$bJ,~>
+nGa!'F*%B]F)us0EH#j_kfWg=s(iA6DXm@=q/UQUF+\Q6F8u8]F8pmks"E8\Df"(L@:-IN?b0ZT
+A7a8(C27X'DfB]9qYZ!Fs+>BFF8pl6Er,QNEVT?Mqf;[Ws8Mh8)#nYuU3"\6s3UfGrh+7LD<Pj)
+E;KNSs)\2>&9IkmF+\OTEcH*nEH;$WK6.%l!/(.J*J8oml$$cPeS8uAr;Q`rcuX8KEGoZ:An,7V
+Z!1E2=V at H2=JDQn=^#$8?FjUifkbX(rpg#=~>
+nGa!Xb0'bab0&',aN)<ekhZ0Rs2,N8`UWTAq8peYb0\<2b5_Lab5]ies"Erg`l$HP\@/iR[^ruZ
+]=cY._8=+/`lH0AqY\_>s3Sp8b5]i2ankeRaS>SQqoSi[s8Mi:)#qb$grf$2s6]jdrn>H5`9>/-
+a85bWs2t?@&Bb$qb0\;RaiMQtaN=D[d)u at f!7:TB*RN*Ul,:<Le\T5Gr;Q`rmE3SnaMu-8]t1_^
+Z*LY6YS*\7YbInsYd(L@[CWomfu(l,rpg#=~>
+nGa!1Kn]R,KnY`jKnP-Vq=so@(ANN7qLneFL&_1,s+QYjs+ULQKn]PjrVmSmPD"S[m='KDidKp;
+It3+ at JqAW-re1<*s8N^qs8S::PD0%#Kn]R,Kn]R,L&_+*s8VnK#lfU4Y(bGjs472L%'G;;K_^;u
+K`;"*s+UIP"GQl0Kp2Fg#6'=1s8S::rr2t^qZ$SZ#a5"EJV!BDKS9=(!7q+&$&!qlJUi2ti8&bZ
+HN2V.HJ$nsH@(!dIH>tHo7M_qnGe"~>
+nGa!'F*%B]F*!!6F)uC!q=so.(AMlhqJuN4F8u8]s)Wg6s)\5?F*%A6rVmJfK5tu'm;6Y!ibRXl
+D/O:_E;jkWErL.[rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^As)W7UF3oR>d/O%RU2t?qq/Z at R
+rr7'>F8l1BF8p<&KD]cprc</\s+>Clrr@]Js8R]WK)'q8Dt7mgF8c+=d/A"lEcHVJDJX+Hh.ck%
+s4 at Eef\'s;BaAHhj_aGWEH;'Js*t~>
+nGa!Xb0'bab0&*2b0%j'q=sp0(APtlqT8[6b5_Las2r^2s2tBAb0'b2rVmK$d)jB#mDQm%ikjfp
+`5Taea8X0[ao9H_rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seCs2rL>b3dRUmJd+ogrda\q8rNV
+rr:. at b5VDDb5]W,d/;#jrlWC`s3SpfrrCFBs8UFOchYi*`q%3mb5M>?mJY06aiM`H`P]RNh8'$)
+s4 at Fgf\+%=^^.cnji$TYaN=GNs*t~>
+nG`d+Kn]R,KnY`jre:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]%-3V+L&Ln$KD>4opk/R!
+!<)\Hs8N^qs8S::PD0%#Kn]R,Kn]R,L&_+*s8VnK#lfU4Y(bGjs472L!3Z<T#lfVYL&_1,s+UIP
+"GQl0Kp2Fg"oj:1s8S;]rrA8Zs8J2brfVqfrVhNLrrCXIKa*]nKS+pOpAKUCoE'X;p&0LBK*D%'
+qu)5&n,In~>
+nG`d!F*%B]F*!!6rcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M%,cbZF8buUEVT<Kpi6:R
+!<)\6s8N^as8R^mK6.'FF*%B]F*%B]F8u2[s8Vn9#leseU3"\6s3UcF!2BI6#leuGF8u8]s)\2>
+"EXTaF+aC3"oiXbs8R`Mrr@]Js8IWRre#63rVgm:rrCFCEs at 8;EcH*npAJt1oE'")p&8q0E<Z,X
+qu(SWn,In~>
+nG`dRb0'bab0&*2rlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E%.higb5M4YaS>POprNHV
+!<)]8s8N_Ys8UHgd)uC8b0'bab0'bab5_F_s8Vo;#li&igrf$2s6]gc!8RRr#li'Ib5_Las2t?@
+"Npbeb0^(/"ol`fs8UIErrCFBs8L at Jrm8d/rVjt<rrDH`ap-57aiMQtpAN&3oE*)+p&<#2a9D@\
+qu+[[n,In~>
+nG`d+Kn]R,KnY`jre:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]$fmM*L&_1,L&_1,s8 at WO
+s7h<Jrt:Oqs-&/#L&[?jL&_1,L&_1,s8 at ZOs7q?Ss+Q00L";Iff)G[LY5X+\s+UK,s8RfQL&V)T
+L&Zj\s87QSs+Q1,s-*E]!0d9Zrf[KbPD+_jre:=N!7q%$!0dA8s8MtNs8<"Prr2eK"oj;Vs+Q0q
+s*t~>
+nG`d!F*%B]F*!!6rcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M$fHYYF8u8]F8u8]s8@!=
+s7g[8rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^As)W7UF3oR>d/O%FUAf3>s)\3]s8R0?F8l1B
+F8p<&s86pAs)W8]s+C:M!/(.Jrdt at RK6),6rcA&<!7:Ua!/(5ks8Mt<s8<"?rr2e9"oiZDs)W8M
+s*t~>
+nG`dRb0'bab0&*2rlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E$hM`fb5_Lab5_Las8C(?
+s7jb:rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seCs2rL>b3dRUmJd+ch#>G%s2tAas8U7Ab5VDD
+b5]W,s8:"Cs2rLas3U`E!7:TBrm1fJd)sN2rlY3>!:B[+!7:\es8Mu>s8<#Arr2f;"olaFs2rLQ
+s*t~>
+nG`d+Kn]R,KnY`jre:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]$fmM*L&_1,L&_1,s8 at WO
+s7h<Jrt:Oqs-&/#L&[?jL&_1,L&_1,s8 at ZOs7q?Ss+Q00L";Iff)G[LY5X+Zs+UK,s8RfNrre&U
+Kn]R)Ka%L1L&_1:rVlk]qZ$PY"TO[>L&_.+rVllKqh5$6rIt:OrIt:O!ep[Sqh54RL&_1,L%#%l~>
+nG`d!F*%B]F*!!6rcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M$fHYYF8u8]F8u8]s8@!=
+s7g[8rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^As)W7UF3oR>d/O%FUAf3<s)\3]s8R0<rrdEC
+F*%BZEs;SbF8u8mrVlkMqZ$PI"TO*qF8u5\rVllEqf;airH&#=rH&#=!d"DAqf;r at F8u8]F79-Z~>
+nG`dRb0'bab0&*2rlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E$hM`fb5_Lab5_Las8C(?
+s7jb:rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seCs2rL>b3dRUmJd+ch#>G#s2tAas8U7>rrgLE
+b0'b^ap%gfb5_LgrVllEqZ$QA"TQikb5_I`rVllbqoSocrQ>0?rQ>0?!m:QCqoT*Bb5_Lab4#@\~>
+nG`O$L&V,PK`RD;re:@OrIl$eKn]P\s8RfQs+UK,PD0$js8Re,s-*E]$fmM*L&_1,L&_1,s8 at WO
+s7h<Jrt:Oqs-&/#L&[?jL&_1,L&_1,s8 at ZOs7q?Qs+Q00L";IcrrB5$Ka.R2s+ULQL&CrRL&Zj\
+s87QSs+Q1,s-*E]!0d9Zrf[KbPD+_jre:=N!7q%$!0dD9rr;qNs8N.Ss8W(P#lfU4s+ULQKn]!q
+J,~>
+nG`NoF8l4>ErgpnrcA)=rGrbSF*%A&s8R0?s)\3]K6.'6s8R.]s+C:M$fHYYF8u8]F8u8]s8@!=
+s7g[8rt9tas+>BFF8pl6F8u8]F8u8]s8@$=s7p^?s)W7UF3oR;rrAemEsDYcs)\5?F8Z%@F8p<&
+s86pAs)W8]s+C:M!/(.Jrdt at RK6),6rcA&<!7:Ua!/(8lrr;q<s8N.As8W(>#leses)\5?F*$gM
+J,~>
+nG`OKb5VG at aoTlhrlY6?rQ5oUb0'b,s8U7As2tAad)uC2s8U6as3U`E$hM`fb5_Lab5_Las8C(?
+s7jb:rt<]Ys3Sp8b5]i2b5_Lab5_Las8C+?s7seAs2rL>b3dRRrrCjRap.mgs2tBAb5D8Bb5]W,
+s8:"Cs2rLas3U`E!7:TBrm1fJd)sN2rlY3>!:B[+!7:_frr;r>s8N/Cs8W)@#li&is2tBAb0'2Q
+J,~>
+nG`O$L&V,PK`RD;re:@OrIka]Kn]P\s8RfQs+UK,PD/u8s+LLRPPtLhjHG:Os8Re,s8RfQrIk7O
+pkAbJ&sN at qPD,3Ss-&.js8Re,s8RfQrIt:Oq1T%QKnZ[`es$%3!3Z<T#60DWL&_1,r;QqSs+Q1,
+s8 at WTs+Q1,s-*E]!0d9Zrf[KbPD+_jre:=N!7q%$!0dD9rr;qNs8N.Ss8W(P#lfU4s+ULQKn]!q
+J,~>
+nG`NoF8l4>ErgpnrcA)=rGrJKF*%A&s8R0?s)\3]K6."ks)S5 at KDkfXi.H)ls8R.]s8R0?rGqu=
+piHK8&qg5aK6)Zds+>B6s8R.]s8R0?rH&#=q/Zc?F*"'sd"D8r!2BI6#6/cEF8u8]r;QqAs)W8]
+s8@!Bs)W8]s+C:M!/(.Jrdt at RK6),6rcA&<!7:Ua!/(8lrr;q<s8N.As8W(>#leses)\5?F*$gM
+J,~>
+nG`OKb5VG at aoTlhrlY6?rQ5WMb0'b,s8U7As2tAad)u=es2kBBd/EtPo?bY&s8U6as8U7ArQ5-?
+pr`X:'%$[Yd)s_Xs3Sp2s8U6as8U7ArQ>0?q8rpAb0&M^mEke2!8RRr#62jGb5_Lar;QrCs2rLa
+s8C(Ds2rLas3U`E!7:TBrm1fJd)sN2rlY3>!:B[+!7:_frr;r>s8N/Cs8W)@#li&is2tBAb0'2Q
+J,~>
+nG`O$L&V,PK`RD;re:@OrIka]Kn]P\s8RfQs+UK,PD/u8s+LLRPPkFfPD+_js+Q1,s+ULOK`M/J
+L&_/cPQ1ZHKp.5js+Q1,s+Q1,s+ULOL&_2KKa.R2Ks$-\PPkF\Y5X+Zs+UK,s8RfNrrn,VKn]R,
+rIkFTKn]R,PPtL]PPY:aPQ-jHPD+_jre:=N!7q%$!0dD9rr;qNs8N.Ss8W(P#lfU4s+ULQKn]!q
+J,~>
+nG`NoF8l4>ErgpnrcA)=rGrJKF*%A&s8R0?s)\3]K6."ks)S5 at KDb`VK6),6s)W8]s)\5=Erc78
+F8u7QKE(t(F+\Q6s)W8]s)W8]s)\5=F8u:9EsDYcF/!a&KDb`LUAf3<s)\3]s8R0<rrmKDF*%B]
+rGr/BF*%B]KDkfMKDPTQKE$T(K6),6rcA&<!7:Ua!/(8lrr;q<s8N.As8W(>#leses)\5?F*$gM
+J,~>
+nG`OKb5VG at aoTlhrlY6?rQ5WMb0'b,s8U7As2tAad)u=es2kBBd/<nNd)sN2s2rLas2tB?aoMJ:
+b5_JSd/X-mb0\<2s2rLas2rLas2tB?b5_M;ap.mgb1t/,d/<nDh#>G#s2tAas8U7>rrpRFb0'ba
+rQ5<Db0'bad/EtEd/*bId/VJmd)sN2rlY3>!:B[+!7:_frr;r>s8N/Cs8W)@#li&is2tBAb0'2Q
+J,~>
+nG`O$L&V,PK`RD;re:@OrIka]Kn]P\s8RfQs+UK,PD/u8s+LLRPPkFfPD+_js+Q1,s+ULOK`M/J
+L&_/QPQ(R`Kp.5irs4>Ys+Q1,s+ULOL&V,KKa.R2Ks(I,PPkF\Y5X+Zs+UK,s8RfNrrn,VKn]R,
+rIkFTKn]R,PPtL]PPY:cPQ-jHPD+_jKn]I)!7q%$!0dD9rr;qNs8N.Ss8W(P#QKL3s+ULQL$ntk~>
+nG`NoF8l4>ErgpnrcA)=rGrJKF*%A&s8R0?s)\3]K6."ks)S5 at KDb`VK6),6s)W8]s)\5=Erc78
+F8u7?KDtlPF+\Q5rs3]Gs)W8]s)\5=F8l49EsDYcF/&]]KDb`LUAf3<s)\3]s8R0<rrmKDF*%B]
+rGr/BF*%B]KDkfMKDPTSKE$T(K6),6F*%9Z!7:Ua!/(8lrr;q<s8N.As8W(>#QJjds)\5?F70'Y~>
+nG`OKb5VG at aoTlhrlY6?rQ5WMb0'b,s8U7As2tAad)u=es2kBBd/<nNd)sN2s2rLas2tB?aoMJ:
+b5_JAd/O%Hb0\<1rs6dIs2rLas2tB?b5VG;ap.mgb2!$ad/<nDh#>G#s2tAas8U7>rrpRFb0'ba
+rQ5<Db0'bad/EtEd/*bKd/VJmd)sN2b0'Y^!:B[+!7:_frr;r>s8N/Cs8W)@#QMrhs2tBAb3o:[~>
+nG`O$L&V,PK`RD;re:@OrIkLVKn]P\s8RfOrrRn<L&M&OK`V4;r;R+fs+ULQKn]R,L&_+*!<;hJ
+qu6_OPD/o6s+ULQ!/:FPs+UIPrIkCSKn]P\rr3#MPPkFaY5a30s+UFO!/:@N%u(%;L&_1,s+Q1,
+Kn]R,PPtL]PPY:cPQ-jHPD+_jKn]I)!7q%$!0dD9rr;qNs8N.Ss8W(P#QKL3s+ULQL$ntk~>
+nG`NoF8l4>ErgpnrcA)=rGr5DF*%A&s8R0=rrR7oF8c.=Erl;nr;R+Vs)\5?F*%B]F8u2[!<;h8
+qu6_=K6-qis)\5?!-A/>s)\2>rGr,AF*%A&rr3#GKDb`QUAo:Us)\/=!-A)<%s.blF8u8]s)W8]
+F*%B]KDkfMKDPTSKE$T(K6),6F*%9Z!7:Ua!/(8lrr;q<s8N.As8W(>#QJjds)\5?F70'Y~>
+nG`OKb5VG at aoTlhrlY6?rQ5BFb0'b,s8U7?rrU?ib5MA?aoVOhr;R,Ns2tBAb0'bab5_F_!<;i:
+qu6`?d)u7cs2tBA!6Y<@s2t?@rQ59Cb0'b,rr3#dd/<nIh#GO>s2t<?!6Y6>&'Fppb5_Las2rLa
+b0'bad/EtEd/*bKd/VJmd)sN2b0'Y^!:B[+!7:_frr;r>s8N/Cs8W)@#QMrhs2tBAb3o:[~>
+nG`O$L&V,PK`RD;re:@Os+LUUL&Zj\rVlkOrVlqQPD/u8s+LLRPPkFfPQ-@:s+Q1,s+ULOK`h@/
+s+UFOs+U at M!elhlqu?\Ms8N(Qrr<"Prr;qN"TO10s+UIP!S3J4rr]G(Kn]F(!/:@N%u(%;L&_1,
+s+Q1,Kn]R,PPtL]PPY:bPQ-jHPD+_jL&:lMf)::(s+Q[9L&V,NL&_/SL&_2PKa7X3L&Zl,s+Tn@
+J,~>
+nG`NoF8l4>ErgpnrcA)=s)S>CF8p<&rVlk=rVlq?K6."ks)S5 at KDb`VKE$#ms)W8]s)\5=Es)G`
+s)\/=s)\);!cs!8qu?\;s8N(?rr<">rr;q<"TNOas)\2>!RQJsrr]"qF*%6Y!-A)<%s.blF8u8]
+s)W8]F*%B]KDkfMKDPTRKE$T(K6),6F8Pt;d/A"es)WhlF8l4<F8u7AF8u:>EsM_dF8p=]s)[W.
+J,~>
+nG`OKb5VG at aoTlhrlY6?s2kKEb5]W,rVll?rVlrAd)u=es2kBBd/<nNd/V8gs2rLas2tB?aoh[d
+s2t<?s2t6=!m8m4qu?]=s8N)Arr<#@rr;r>"TQWes2t?@!U\83rr_'Vb0'V]!6Y6>&'Fppb5_La
+s2rLab0'bad/EtEd/*bJd/VJmd)sN2b5;2=mJY0/s2r^fb5VG>b5_JCb5_M at ap7shb5]Was2sd0
+J,~>
+nG`O$L&V,PK`mV>L&Zl+s8RcUs+UK,L&M#OL&M#QKp.5hs8RcRs-*B\!gEY<rr3C\s8RfQs+UK,
+s+UK,rVunOqu6_OPD/o6s+ULQ!/:FPs+UIPrIkCSKn]P\rr3#MPPkF_Y5a30qu6YMr;R:]s+Q1,
+s+UK,L&Zj\s8S;]rrA8Zrs4hgPQ-i#L&Zl(rrCXKK`_:.PQ$:8s8 at ZOrrRoSs8I]Ws+Q1,L&_1,
+mf.e~>
+nG`NoF8l4>Es.-qF8p=\s8R-Cs)\3]F8c+=F8c+?F+\Q4s8R- at s+C7L!e^Morr3CJs8R0?s)\3]
+s)\3]rVun=qu6_=K6-qis)\5?!-A/>s)\2>rGr,AF*%A&rr3#GKDb`OUAo:Uqu6Y;r;R:Ks)W8]
+s)\3]F8p<&s8R`Mrr@]Jrs48WKE$RFF8p=YrrCFEEruA_KDorks8@$=rrR9As8I'Es)W8]F8u8]
+mf.e~>
+nG`OKb5VG at aop)kb5]W`s8U4Es2tAab5M>?b5M>Ab0\<0s8U4Bs3U]D!mptirr3DLs8U7As2tAa
+s2tAarVuo?qu6`?d)u7cs2tBA!6Y<@s2t?@rQ59Cb0'b,rr3#dd/<nGh#GO>qu6Z=r;R;Ms2rLa
+s2tAab5]W,s8UIErrCFBrs7!Od/VJ8b5]W]rrDHbao_Ucd/M2es8C+?rrU at Cs8L.Gs2rLab5_La
+mf.e~>
+nG`O$L&V,PK`[J<L&CuNK`qF0s+Q1*rr at cOrrRn<L&M&OK`V4;r;Qh^s+UIP%#+`]L&_1,s+UK,
+s+UFOs+U at M!elhlqu?\Ms8N(Qrr<"Prr;qN"TO10s+UIP!S3J4rr]G(Kn]4"%u(%;L&_1,s+Q1,
+Kn]R,PPtL]PPY:bPQ-jHPD+_jL&:lMf)::(s+Q[9L&V,PKa.R2s8RfQs8I]Ws+Q1,L&_1,mf.e~>
+nG`NoF8l4>Erq!oF8Z(<Es2Mas)W8[rr at -=rrR7oF8c.=Erl;nr;QhNs)\2>%!2IKF8u8]s)\3]
+s)\/=s)\);!cs!8qu?\;s8N(?rr<">rr;q<"TNOas)\2>!RQJsrr]"qF*%$S%s.blF8u8]s)W8]
+F*%B]KDkfMKDPTRKE$T(K6),6F8Pt;d/A"es)WhlF8l4>EsDYcs8R0?s8I'Es)W8]F8u8]mf.e~>
+nG`OKb5VG at ao]rib5D;>aoqaes2rL_rrC4?rrU?ib5MA?aoVOhr;QiFs2t?@%*JVMb5_Las2tAa
+s2t<?s2t6=!m8m4qu?]=s8N)Arr<#@rr;r>"TQWes2t?@!U\83rr_'Vb0'DW&'Fppb5_Las2rLa
+b0'bad/EtEd/*bJd/VJmd)sN2b5;2=mJY0/s2r^fb5VG at ap.mgs8U7As8L.Gs2rLab5_Lamf.e~>
+nG`O$L&V,PK`[J<L&:lRL&Zl,Kn]L*!/:CO!elhlrVunO!WSA]rrSDaL&V)\L&_1,s8RfQL&Zl,
+L&M&OL&:lOKp.5fs8RfQrr at cPs8RfPs8@WSs+Q1,L&V)Qes$%3"0VZXL%YHVL&Zj\s8RfQKn]P\
+L&_1:rVlk]qYphbs-*JHKn]P\qu6ZIrIk=QKp2Lirr<"P#60DWs+ULQre:CP"blu1s8Rf at s*t~>
+nG`NoF8l4>Erq!oF8Pt at F8p=]F*%<[!-A,=!cs!8rVun=!WRfMrrRiQF8l1JF8u8]s8R0?F8p=]
+F8c.=F8Pt=F+\Q2s8R0?rr at ->s8R0>s8@!As)W8]F8l1?d"D8r"/>g:F7oPDF8p<&s8R0?F*%A&
+F8u8mrVlkMqYphRs+C?(F*%A&qu6ZCrGr&?F+aI5rr<">#6/cEs)\5?rcA,>"`s]bs8R0.s*t~>
+nG`OKb5VG at ao]rib5;2Bb5]Wab0'\_!6Y9?!m8m4rVuo?!WUOErrURIb5VDLb5_Las8U7Ab5]Wa
+b5MA?b5;2?b0\<.s8U7ArrC4 at s8U7@s8C(Cs2rLab5VDAmEke2"5Nq!b4YcFb5]W,s8U7Ab0'b,
+b5_LgrVllEqYpiJs3Uemb0'b,qu6Z`rQ53Ab0^.1rr<#@#62jGs2tBArlY9@"j6kfs8U70s*t~>
+p]#dES,i?aJ,~>
+p]#dES,i?aJ,~>
+p]#dES,i?aJ,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+o`#!5WoMY0s5WDE!6>&<_uB_Wrr2u=p&G&loD\l4<TETKr2KbWh#Dm~>
+o`#!5WoMY0s5WDE!6>&<_uB_Wrr2u=p&G&loD\l4<TETKr2KbWh#Dm~>
+o`#!5WoMY0s5WDE!6>&<_uB_Wrr2u=p&G&loD\l4<TETKr2KbWh#Dm~>
+pAY0R<W2suEp<T)j)XYhs&K$t!TS4irr=)<!!((9s8V-ArrC+=s8T+err`=^s/H(ls8Q*krr[9A
+<TEWL!35qs!-6lpJ,~>
+pAY0R<W2suEp<T)j)XYhs&K$t!TS4irr=)<!!((9s8V-ArrC+=s8T+err`=^s/H(ls8Q*krr[9A
+<TEWL!35qs!-6lpJ,~>
+pAY0R<W2suEp<T)j)XYhs&K$t!TS4irr=)<!!((9s8V-ArrC+=s8T+err`=^s/H(ls8Q*krr[9A
+<TEWL!35qs!-6lpJ,~>
+pAY:r3TL.>j6?REj)XYhs&K$t!TS4grrE,"q#C at okPkR_!<3#uWpfrl`rK->EWF/Rs8Q*krrE+[
+n,EEg!8%7$~>
+pAY:r3TL.>j6?REj)XYhs&K$t!TS4grrE,"q#C at okPkR_!<3#uWpfrl`rK->EWF/Rs8Q*krrE+[
+n,EEg!8%7$~>
+pAY:r3TL.>j6?REj)XYhs&K$t!TS4grrE,"q#C at okPkR_!<3#uWpfrl`rK->EWF/Rs8Q*krrE+[
+n,EEg!8%7$~>
+pAY-nEr>qDEo[2[ElS0?<HA*=(33Dqj5Y1#<HA,>WrN+!<HA-"ElV1#qu?[rrVunts8N at b<E6&>
+*KF."q>WDSWrN+ZElV1?j&I*?<TF,><E5(ZWiD(ZWrN*Z<H at ."s,L*>j)R-[<N?(>j8]."<N?)Z
+ElV1?qYpb[!'1'>!36%u%rt[Ms8V+Z<B4(Zs)M+[j8Aogj&H(><TF,><E8)ZElW3#j8AoXWW;ts
+s)J7&<N9&>rr3ML<E7*>s2S,[a8b1?<E8)Qs*t~>
+pAY-nEr>qDEo[2[ElS0?<HA*=(33Dqj5Y1#<HA,>WrN+!<HA-"ElV1#qu?[rrVunts8N at b<E6&>
+*KF."q>WDSWrN+ZElV1?j&I*?<TF,><E5(ZWiD(ZWrN*Z<H at ."s,L*>j)R-[<N?(>j8]."<N?)Z
+ElV1?qYpb[!'1'>!36%u%rt[Ms8V+Z<B4(Zs)M+[j8Aogj&H(><TF,><E8)ZElW3#j8AoXWW;ts
+s)J7&<N9&>rr3ML<E7*>s2S,[a8b1?<E8)Qs*t~>
+pAY-nEr>qDEo[2[ElS0?<HA*=(33Dqj5Y1#<HA,>WrN+!<HA-"ElV1#qu?[rrVunts8N at b<E6&>
+*KF."q>WDSWrN+ZElV1?j&I*?<TF,><E5(ZWiD(ZWrN*Z<H at ."s,L*>j)R-[<N?(>j8]."<N?)Z
+ElV1?qYpb[!'1'>!36%u%rt[Ms8V+Z<B4(Zs)M+[j8Aogj&H(><TF,><E8)ZElW3#j8AoXWW;ts
+s)J7&<N9&>rr3ML<E7*>s2S,[a8b1?<E8)Qs*t~>
+pAY+mrW";dWrE(!s/H(!!!$">ErT,[<?6+[!!#"ZW`<(!WW6$>EiK*>3<6)Ws8Q*ts8Q(,s)K,[
+3E9&Z*E<*[qYrPUWrN+!!!#"ZW`:&[<TE*[3E6("<<*"Z!<6%!3?;-"NW<'"EcO/?<N?'!WrH'>
+<<1(>!!#"Za8>lS<<*%!!$-+[s&C(>!6=+"3E6&Zs&C(>*HM)X&B at cN3E>,"*B?,#rr<$>*EE%;
+!NH.u<>smt!$)%>*<<,>WW4&"!<;'Z3B8,[*B at +?WqQIC~>
+pAY+mrW";dWrE(!s/H(!!!$">ErT,[<?6+[!!#"ZW`<(!WW6$>EiK*>3<6)Ws8Q*ts8Q(,s)K,[
+3E9&Z*E<*[qYrPUWrN+!!!#"ZW`:&[<TE*[3E6("<<*"Z!<6%!3?;-"NW<'"EcO/?<N?'!WrH'>
+<<1(>!!#"Za8>lS<<*%!!$-+[s&C(>!6=+"3E6&Zs&C(>*HM)X&B at cN3E>,"*B?,#rr<$>*EE%;
+!NH.u<>smt!$)%>*<<,>WW4&"!<;'Z3B8,[*B at +?WqQIC~>
+pAY+mrW";dWrE(!s/H(!!!$">ErT,[<?6+[!!#"ZW`<(!WW6$>EiK*>3<6)Ws8Q*ts8Q(,s)K,[
+3E9&Z*E<*[qYrPUWrN+!!!#"ZW`:&[<TE*[3E6("<<*"Z!<6%!3?;-"NW<'"EcO/?<N?'!WrH'>
+<<1(>!!#"Za8>lS<<*%!!$-+[s&C(>!6=+"3E6&Zs&C(>*HM)X&B at cN3E>,"*B?,#rr<$>*EE%;
+!NH.u<>smt!$)%>*<<,>WW4&"!<;'Z3B8,[*B at +?WqQIC~>
+p&?N%WiB&!irH+ZWW<&!NrQ*Z`rM,[!33%!WrF*[<E9&>ErV."WW9(!*QS*Xs&K$ts&BI,EZL2?
+s/H(Zs&E(qruqHCs8T)!<W<'!s&E)!s)K-?*?F0?*TP0\`rN.><E8&ZNrAtYWW<%u%03EK!6>+"
+<N6%!rrB(rrttfW!-/'[<WC)>a8\/"EZP2[<E7'>N]@*>qYq$*WrN*>*WP."WW6'!EcV*X!NH.u
+<>"7k*TI-[rrB)!*EE->!<5&>rVlp>3QLdlJ,~>
+p&?N%WiB&!irH+ZWW<&!NrQ*Z`rM,[!33%!WrF*[<E9&>ErV."WW9(!*QS*Xs&K$ts&BI,EZL2?
+s/H(Zs&E(qruqHCs8T)!<W<'!s&E)!s)K-?*?F0?*TP0\`rN.><E8&ZNrAtYWW<%u%03EK!6>+"
+<N6%!rrB(rrttfW!-/'[<WC)>a8\/"EZP2[<E7'>N]@*>qYq$*WrN*>*WP."WW6'!EcV*X!NH.u
+<>"7k*TI-[rrB)!*EE->!<5&>rVlp>3QLdlJ,~>
+p&?N%WiB&!irH+ZWW<&!NrQ*Z`rM,[!33%!WrF*[<E9&>ErV."WW9(!*QS*Xs&K$ts&BI,EZL2?
+s/H(Zs&E(qruqHCs8T)!<W<'!s&E)!s)K-?*?F0?*TP0\`rN.><E8&ZNrAtYWW<%u%03EK!6>+"
+<N6%!rrB(rrttfW!-/'[<WC)>a8\/"EZP2[<E7'>N]@*>qYq$*WrN*>*WP."WW6'!EcV*X!NH.u
+<>"7k*TI-[rrB)!*EE->!<5&>rVlp>3QLdlJ,~>
+nc':'WW9(!WW<&!WrK(!WW3$!a8`.>rVumt#QFe(s/H(!!;QTo<W2st<WE(*NZB/#WW<)!<E8nq
+('(B7s/H(ZrrB)!<E9)!<<+%[j8W+Zrr35'!<<(!<N6&srrK,"rr3E-Wi?(!s&E(!!9=(ZWr2l*
+WW;'"!*-$!s/H)!s8>sts8Q(%WW3$!a8,`C!36)!<E9)!!3-%!q>UJq!;uls<=]$/WrE'>rrB)!
+WW<&!Wr;r"j)P-"p&BO~>
+nc':'WW9(!WW<&!WrK(!WW3$!a8`.>rVumt#QFe(s/H(!!;QTo<W2st<WE(*NZB/#WW<)!<E8nq
+('(B7s/H(ZrrB)!<E9)!<<+%[j8W+Zrr35'!<<(!<N6&srrK,"rr3E-Wi?(!s&E(!!9=(ZWr2l*
+WW;'"!*-$!s/H)!s8>sts8Q(%WW3$!a8,`C!36)!<E9)!!3-%!q>UJq!;uls<=]$/WrE'>rrB)!
+WW<&!Wr;r"j)P-"p&BO~>
+nc':'WW9(!WW<&!WrK(!WW3$!a8`.>rVumt#QFe(s/H(!!;QTo<W2st<WE(*NZB/#WW<)!<E8nq
+('(B7s/H(ZrrB)!<E9)!<<+%[j8W+Zrr35'!<<(!<N6&srrK,"rr3E-Wi?(!s&E(!!9=(ZWr2l*
+WW;'"!*-$!s/H)!s8>sts8Q(%WW3$!a8,`C!36)!<E9)!!3-%!q>UJq!;uls<=]$/WrE'>rrB)!
+WW<&!Wr;r"j)P-"p&BO~>
+p\u.P<WE*>3<8([WrK(!rrB)!<?9*[WrL+>WW<"ts&B=(*EE,>3N<)Ss8Q(2s/L+><E9(!j8U-"
+WW<(Z*HM)X(rrWVEiT/>!<<'!WrH(!s8R*[j8Y."<E9%u%`\Ris#F*"!36'ZWrK(!rr3E-WlG+>
+iuO/[!<<'!Wr2l8EZP0[!07'ZWlG+>iuO/#*TQ0?<Q>*>s2S.9rsJh,s8R*[j/N+>!35kp!NH.t
+s8Q(8rrB)!3E?)"ErV."ruG,>a)^4?s2P,>pA]X~>
+p\u.P<WE*>3<8([WrK(!rrB)!<?9*[WrL+>WW<"ts&B=(*EE,>3N<)Ss8Q(2s/L+><E9(!j8U-"
+WW<(Z*HM)X(rrWVEiT/>!<<'!WrH(!s8R*[j8Y."<E9%u%`\Ris#F*"!36'ZWrK(!rr3E-WlG+>
+iuO/[!<<'!Wr2l8EZP0[!07'ZWlG+>iuO/#*TQ0?<Q>*>s2S.9rsJh,s8R*[j/N+>!35kp!NH.t
+s8Q(8rrB)!3E?)"ErV."ruG,>a)^4?s2P,>pA]X~>
+p\u.P<WE*>3<8([WrK(!rrB)!<?9*[WrL+>WW<"ts&B=(*EE,>3N<)Ss8Q(2s/L+><E9(!j8U-"
+WW<(Z*HM)X(rrWVEiT/>!<<'!WrH(!s8R*[j8Y."<E9%u%`\Ris#F*"!36'ZWrK(!rr3E-WlG+>
+iuO/[!<<'!Wr2l8EZP0[!07'ZWlG+>iuO/#*TQ0?<Q>*>s2S.9rsJh,s8R*[j/N+>!35kp!NH.t
+s8Q(8rrB)!3E?)"ErV."ruG,>a)^4?s2P,>pA]X~>
+p\t5nr;Zp?WrI,<!!*&t!!92#<W2t"<N6&ts8Q("s/Q%u!lq;@q#:=orW!*BW`<(!*W?'=Wr;u!
+*TR(t!$2"<%EGIKs8N)!s&E)!s5P.!!!90#<W2pt3W/pYs&K$u"02C$!<3!-!36'!!!"&>WW<)!
+!35tss&BR/WW;)Z<HA+>!!"&>iuS+!!`f8#rVupuqYpp'WrN+Z*<6([rrB(prrM-[rDa3bEcV0[
+WrH(!s,R$Xs/Q%u!EI2>!!+,#pA]X~>
+p\t5nr;Zp?WrI,<!!*&t!!92#<W2t"<N6&ts8Q("s/Q%u!lq;@q#:=orW!*BW`<(!*W?'=Wr;u!
+*TR(t!$2"<%EGIKs8N)!s&E)!s5P.!!!90#<W2pt3W/pYs&K$u"02C$!<3!-!36'!!!"&>WW<)!
+!35tss&BR/WW;)Z<HA+>!!"&>iuS+!!`f8#rVupuqYpp'WrN+Z*<6([rrB(prrM-[rDa3bEcV0[
+WrH(!s,R$Xs/Q%u!EI2>!!+,#pA]X~>
+p\t5nr;Zp?WrI,<!!*&t!!92#<W2t"<N6&ts8Q("s/Q%u!lq;@q#:=orW!*BW`<(!*W?'=Wr;u!
+*TR(t!$2"<%EGIKs8N)!s&E)!s5P.!!!90#<W2pt3W/pYs&K$u"02C$!<3!-!36'!!!"&>WW<)!
+!35tss&BR/WW;)Z<HA+>!!"&>iuS+!!`f8#rVupuqYpp'WrN+Z*<6([rrB(prrM-[rDa3bEcV0[
+WrH(!s,R$Xs/Q%u!EI2>!!+,#pA]X~>
+pAY6TWiF,<rs6ZFa2e2[EiS1!rrpHCa8c1[rVuoXs8N8_WoO-Za8#ZHj/T->s8V->s8T+!j8Z+Z
+WiG[j#KQlEa8c2"j8K#XWWV;]j5^(;s/H;'a8c1[WoO*Y!6>*=!6>*=!QV5>rr^=As2Y$:s5X.Z
+#fluFWiH+!a/]+<s/Q+Zs8N/@WlOr8!?K5Zrrf at Bs8U.6rrC+<<<2(YrtKM6s5W/>s2V/"a8c2"
+WlP/>j/T-Os*t~>
+pAY6TWiF,<rs6ZFa2e2[EiS1!rrpHCa8c1[rVuoXs8N8_WoO-Za8#ZHj/T->s8V->s8T+!j8Z+Z
+WiG[j#KQlEa8c2"j8K#XWWV;]j5^(;s/H;'a8c1[WoO*Y!6>*=!6>*=!QV5>rr^=As2Y$:s5X.Z
+#fluFWiH+!a/]+<s/Q+Zs8N/@WlOr8!?K5Zrrf at Bs8U.6rrC+<<<2(YrtKM6s5W/>s2V/"a8c2"
+WlP/>j/T-Os*t~>
+pAY6TWiF,<rs6ZFa2e2[EiS1!rrpHCa8c1[rVuoXs8N8_WoO-Za8#ZHj/T->s8V->s8T+!j8Z+Z
+WiG[j#KQlEa8c2"j8K#XWWV;]j5^(;s/H;'a8c1[WoO*Y!6>*=!6>*=!QV5>rr^=As2Y$:s5X.Z
+#fluFWiH+!a/]+<s/Q+Zs8N/@WlOr8!?K5Zrrf at Bs8U.6rrC+<<<2(YrtKM6s5W/>s2V/"a8c2"
+WlP/>j/T-Os*t~>
+l2LbaWmUhIWW7VMec1.~>
+l2LbaWmUhIWW7VMec1.~>
+l2LbaWmUhIWW7VMec1.~>
+l2Lc)a3jnf`uTa2ec1.~>
+l2Lc)a3jnf`uTa2ec1.~>
+l2Lc)a3jnf`uTa2ec1.~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+JcCT,J,~>
+%%EndData
+showpage
+%%Trailer
+end
+%%EOF

Added: branches/trunk-reorg/thirdparty/slime/doc/slime-small.pdf
===================================================================
(Binary files differ)


Property changes on: branches/trunk-reorg/thirdparty/slime/doc/slime-small.pdf
___________________________________________________________________
Name: svn:mime-type
   + application/octet-stream

Added: branches/trunk-reorg/thirdparty/slime/doc/slime.texi
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/slime.texi	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/slime.texi	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2471 @@
+\input texinfo
+- at c %**start of header
+ at setfilename slime.info 
+ at settitle The Superior Lisp Interaction Mode for Emacs
+
+ at dircategory Emacs
+ at direntry
+* SLIME: (slime).    Superior Lisp Interaction Mode for Emacs.
+ at end direntry
+- at c %**end of header
+
+ at set EDITION 3.0-alpha
+ at set SLIMEVER 3.0-alpha
+ at c @set UPDATED @today{}
+ at set UPDATED @code{$Date: 2007/09/17 13:44:48 $}
+ at set TITLE SLIME User Manual
+ at settitle @value{TITLE}, version @value{EDITION}
+
+ at copying
+Written by Luke Gorrie.
+
+Additional contributions: Jeff Cunningham,
+
+This file has been placed in the public domain.
+ at end copying
+
+ at titlepage
+ at title @value{TITLE}
+ at titlefont{version @value{EDITION}}
+ at sp 2
+ at center @image{slime-small}
+ at sp 4
+ at subtitle Compiled: @value{UPDATED}
+
+ at page
+ at insertcopying
+
+ at end titlepage
+
+
+ at macro SLIME
+ at acronym{SLIME}
+ at end macro
+
+ at macro SLDB
+ at acronym{SLDB}
+ at end macro
+
+ at macro REPL
+ at acronym{REPL}
+ at end macro
+
+ at macro CVS
+ at acronym{CVS}
+ at end macro
+
+ at macro kbditem{key, command}
+ at item \key\
+ at itemx M-x \command\
+ at kindex \key\
+ at findex \command\
+ at c
+ at end macro
+
+ at macro kbditempair{key1, key2, command1, command2}
+ at item \key1\, M-x \command1\
+ at itemx \key2\, M-x \command2\
+ at kindex \key1\
+ at kindex \key2\
+ at findex \command1\
+ at findex \command2\
+ at c
+ at end macro
+
+ at macro cmditem{command}
+ at item M-x \command\
+ at findex \command\
+ at c
+ at end macro
+
+ at macro kbdanchorc{key, command, comment}
+ at anchor{\command\}
+ at item \key\
+ at code{\command\}
+ at i{\comment\}@*
+ at end macro
+
+ at macro fcnindex{name}
+ at item \name\
+ at xref{\name\}.
+ at end macro
+
+ at c @setchapternewpage off
+ at c @shortcontents
+ at contents
+
+ at ifnottex
+ at node Top
+ at top SLIME
+
+ at SLIME{} is the ``Superior Lisp Interaction Mode for Emacs''. This is
+the manual for version @value{SLIMEVER}.
+
+ at insertcopying
+ at end ifnottex
+
+ at menu
+* Introduction::                
+* Getting started::             
+* slime-mode::                  
+* REPL::                        
+* Debugger::                    
+* Extras::                      
+* Customization::               
+* Tips and Tricks::             
+* Credits::                     
+ at c * Index to Functions::          
+* Key Index::          
+* Command Index::          
+* Variable Index::
+ at end menu
+
+ at c ----------------------- 
+ at node Introduction
+ at chapter Introduction
+
+ at SLIME{} is the ``Superior Lisp Interaction Mode for Emacs.''
+
+ at SLIME{} extends Emacs with support for interactive programming in
+Common Lisp. The features are centered around @code{slime-mode}, an
+Emacs minor-mode that complements the standard @code{lisp-mode}. While
+ at code{lisp-mode} supports editing Lisp source files, @code{slime-mode}
+adds support for interacting with a running Common Lisp process for
+compilation, debugging, documentation lookup, and so on.
+
+The @code{slime-mode} programming environment follows the example of
+Emacs's native Emacs Lisp environment. We have also included good
+ideas from similar systems (such as @acronym{ILISP}) and some new
+ideas of our own.
+
+ at SLIME{} is constructed from two parts: a user-interface written in
+Emacs Lisp, and a supporting server program written in Common
+Lisp. The two sides are connected together with a socket and
+communicate using an @acronym{RPC}-like protocol.
+
+The Lisp server is primarily written in portable Common Lisp. The
+required implementation-specific functionality is specified by a
+well-defined interface and implemented separately for each Lisp
+implementation. This makes @SLIME{} readily portable.
+
+ at c ----------------------- 
+ at node Getting started
+ at chapter Getting started
+
+This chapter tells you how to get @SLIME{} up and running.
+
+ at menu
+* Platforms::                   
+* Downloading::                 
+* Installation::                
+* Running::                     
+* Setup Tuning::                
+ at end menu
+
+ at c ----------------------- 
+ at node Platforms
+ at section Supported Platforms
+
+ at SLIME{} supports a wide range of operating systems and Lisp
+implementations. @SLIME{} runs on Unix systems, Mac OSX, and Microsoft
+Windows. GNU Emacs versions 20, 21 and 22 and XEmacs version 21 are
+supported.
+
+The supported Lisp implementations, roughly ordered from the
+best-supported, are:
+
+ at itemize @bullet
+ at item
+CMU Common Lisp (@acronym{CMUCL}), 19d or newer
+ at item
+Steel Bank Common Lisp (@acronym{SBCL}), 1.0 or newer
+ at item
+OpenMCL, version 0.14.3 or newer
+ at item
+LispWorks, version 4.3 or newer
+ at item
+Allegro Common Lisp (@acronym{ACL}), version 6 or newer
+ at item
+ at acronym{CLISP}, version 2.35 or newer
+ at item
+Armed Bear Common Lisp (@acronym{ABCL})
+ at item
+Corman Common Lisp (@acronym{CCL}), version 2.51 or newer with the
+patches from @url{http://www.grumblesmurf.org/lisp/corman-patches})
+ at item
+Scieneer Common Lisp (@acronym{SCL}), version 1.2.7 or newer
+ at end itemize
+
+Most features work uniformly across implementations, but some are
+prone to variation. These include the precision of placing
+compiler-note annotations, @acronym{XREF} support, and fancy debugger
+commands (like ``restart frame'').
+
+ at c ----------------------- 
+ at node Downloading
+ at section Downloading SLIME
+
+You can choose between using a released version of @SLIME{} or
+accessing our @CVS{} repository directly. You can download the latest
+released version from our website:
+
+ at url{http://www.common-lisp.net/project/slime/}
+
+We recommend that users who participate in the @code{slime-devel}
+mailing list use the @CVS{} version of the code.
+
+ at menu
+* CVS::                         
+* CVS Incantations::            
+ at end menu
+
+ at c ----------------------- 
+ at node CVS
+ at subsection Downloading from CVS
+
+ at SLIME{} is available from the @CVS{} repository on
+ at file{common-lisp.net}. You have the option to use either the very
+latest code or the tagged @code{FAIRLY-STABLE} snapshot.
+
+The latest version tends to have more features and fewer bugs than the
+ at code{FAIRLY-STABLE} version, but it can be unstable during times of
+major surgery. As a rule-of-thumb recommendation we suggest that if
+you follow the @code{slime-devel} mailing list then you're better off
+with the latest version (we'll send a note when it's undergoing major
+hacking). If you don't follow the mailing list you won't know the
+status of the latest code, so tracking @code{FAIRLY-STABLE} or using a
+released version is the safe option.
+
+If you checkout from @CVS{} then remember to @code{cvs update}
+occasionally.  Improvements are continually being committed, and the
+ at code{FAIRLY-STABLE} tag is moved forward from time to time.
+
+ at menu
+* CVS Incantations::            
+ at end menu
+
+ at c ----------------------- 
+ at node CVS Incantations
+ at subsection CVS incantations
+
+To download @SLIME{} you first configure your @code{CVSROOT} and login
+to the repository.
+
+ at example
+export CVSROOT=:pserver:anonymous@@common-lisp.net:/project/slime/cvsroot
+cvs login
+ at end example
+ at emph{(The password is @code{anonymous})}
+
+The latest version can then be checked out with:
+ at example
+cvs checkout slime
+ at end example
+
+Or the @code{FAIRLY-STABLE} version can be checked out with:
+
+ at example
+cvs checkout -rFAIRLY-STABLE slime
+ at end example
+
+If you want to find out what's new since the version you're currently
+running, you can diff the local @file{ChangeLog} against the
+repository version:
+
+ at example
+cvs diff -rHEAD ChangeLog      # or: -rFAIRLY-STABLE
+ at end example
+
+ at c ----------------------- 
+ at node Installation
+ at section Installation
+
+With a Lisp implementation that can be started from the command-line,
+installation just requires a few lines in your @file{~/.emacs}:
+
+ at vindex inferior-lisp-program
+ at vindex load-path
+ at example 
+(setq inferior-lisp-program "@emph{the path to your Lisp system}")
+(add-to-list 'load-path "@emph{the path of your @file{slime} directory}")
+(require 'slime)
+(slime-setup)
+ at end example
+
+ at iftex
+The snippet above also appears in the @file{README} file. You can
+copy&paste it from there, but remember to fill in the appropriate
+paths.
+ at end iftex
+
+We recommend not loading the @acronym{ILISP} package into Emacs if you
+intend to use @SLIME{}. Doing so will add a lot of extra bindings to
+the keymap for Lisp source files that may be confusing and may not
+work correctly for a Lisp process started by @SLIME{}.
+
+ at c ----------------------- 
+ at node Running
+ at section Running SLIME
+
+ at SLIME{} is started with the Emacs command @kbd{M-x slime}. This uses
+the @code{inferior-lisp} package to start a Lisp process, loads and
+starts the Lisp-side server (known as ``Swank''), and establishes a
+socket connection between Emacs and Lisp. Finally a @REPL{} buffer is
+created where you can enter Lisp expressions for evaluation.
+
+At this point @SLIME{} is up and running and you can start exploring.
+
+You can restart the @code{inferior-lisp} process using the function:
+ at table @kbd
+ at cmditem{slime-restart-inferior-lisp}
+ at end table
+
+ at node Setup Tuning
+ at section Setup Tuning
+
+This section explains ways to reduce @SLIME{}'s startup time and how
+to configure @SLIME{} for multiple Lisp systems.  
+
+Please proceed with this section only if your basic setup works.  If
+you are happy with the basic setup, skip this section.
+
+ at menu
+* Autoloading::                 
+* Multiple Lisps::              
+* Loading Swank faster::        
+* Loading Contribs::            
+ at end menu
+
+ at node Autoloading
+ at subsection Autoloading
+
+The basic setup loads @SLIME{} always, even if you don't use @SLIME{}.
+Emacs will start up a little faster if we load @SLIME{} only on
+demand.  To achieve that, you have to change your @file{~/.emacs}
+slightly:
+
+ at example
+(setq inferior-lisp-program "@emph{the path to your Lisp system}")
+(add-to-list 'load-path "@emph{the path of your @file{slime} directory}")
+(require 'slime-autoloads)
+(slime-setup)
+ at end example
+
+The only difference compared to the basic setup is the line
+ at code{(require 'slime-autoloads)}.  It tells Emacs that the rest of
+ at SLIME{} should be loaded when one of the commands @kbd{M-x slime} or
+ at kbd{M-x slime-connect} is executed the first time.
+
+ at node Multiple Lisps
+ at subsection Multiple Lisps
+
+By default, the command @kbd{M-x slime} starts the program specified
+with @code{inferior-lisp-program}.  If you invoke @kbd{M-x slime} with
+a prefix argument, Emacs prompts for the program which should be
+started instead.  If you need that frequently or if the command
+involves long filenames it's more convenient to set the
+ at code{slime-lisp-implementations} variable in your @file{.emacs}.  For
+example here we define two programs:
+
+ at vindex slime-lisp-implementations
+ at lisp
+(setq slime-lisp-implementations
+      '((cmucl ("cmucl" "-quiet"))
+        (sbcl ("/opt/sbcl/bin/sbcl") :coding-system utf-8-unix)))
+ at end lisp
+
+This variable holds a list of programs and if you invoke @SLIME{} with
+a negative prefix argument, @kbd{M-- M-x slime}, you can select a
+program from that list.  The elements of the list should look like
+
+ at lisp
+(NAME (PROGRAM PROGRAM-ARGS...) &key CODING-SYSTEM INIT INIT-FUNCTION)
+ at end lisp
+
+ at table @code
+ at item NAME
+is a symbol and is used to identify the program.
+ at item PROGRAM
+is the filename of the program.  Note that the filename can contain
+spaces.
+ at item PROGRAM-ARGS
+is a list of command line arguments.  
+ at item CODING-SYSTEM
+the coding system for the connection.  
+ at item INIT
+ at itemx INIT-FUNCTION 
+ ... to be written ...
+ at end table
+
+ at node Loading Swank faster
+ at subsection Loading Swank faster
+
+For SBCL, we recommend that you create a custom core file with socket
+support and @acronym{POSIX} bindings included because those modules
+take the most time to load.  To create such a core, execute the
+following steps:
+
+ at example
+shell$ sbcl
+* (mapc 'require '(sb-bsd-sockets sb-posix sb-introspect sb-cltl2 asdf))
+* (save-lisp-and-die "sbcl.core-for-slime")
+ at end example
+
+After that, add something like this to your @file{.emacs}:
+
+ at lisp
+(setq slime-lisp-implementations 
+      '((sbcl ("sbcl" "--core" "sbcl.core-for-slime"))))
+ at end lisp
+
+For maximum startup speed you can include the Swank server directly in
+a core file.  The disadvantage of this approach is that the setup is a
+bit more involved and that you need to create a new core file when you
+want to update @SLIME{} or @acronym{SBCL}.  The steps to execute are:
+
+ at example
+shell$ sbcl
+* (load ".../slime/swank-loader.lisp")
+* (save-lisp-and-die "sbcl.core-with-slime")
+ at end example
+
+ at noindent
+Then add this to your @file{.emacs}:
+
+ at lisp
+(setq slime-lisp-implementations 
+      '((sbcl ("sbcl" "--core" "sbcl.core-with-slime")
+              :init (lambda (port-file _)
+                      (format "(swank:start-server %S)\n" port-file)))))
+ at end lisp
+
+ at noindent
+Similar setups should also work for other Lisp implementations.
+
+ at node Loading Contribs
+ at subsection Loading Contribs
+... to be written ...
+
+ at node slime-mode
+ at chapter Using slime-mode
+
+ at SLIME{}'s commands are provided via @code{slime-mode}, a minor-mode
+used in conjunction with Emacs's @code{lisp-mode}. This chapter
+describes the @code{slime-mode} and its relatives.
+
+ at menu
+* User-interface conventions::  
+* Key bindings::                
+* Commands::                    
+* Semantic indentation::        
+* Reader conditionals::         
+ at end menu
+
+ at c ----------------------- 
+ at node User-interface conventions
+ at section User-interface conventions
+
+To use @SLIME{} comfortably it is important to understand a few
+``global'' user-interface characteristics. The most important
+principles are described in this section.
+
+ at menu
+* Temporary buffers::           
+* Inferior-lisp::               
+* Multithreading::              
+ at end menu
+
+ at c ----------------------- 
+ at node Temporary buffers
+ at subsection Temporary buffers
+
+Some @SLIME{} commands create temporary buffers to display their
+results. Although these buffers usually have their own special-purpose
+major-modes, certain conventions are observed throughout.
+
+Temporary buffers can be dismissed by pressing @kbd{q}. This kills the
+buffer and restores the window configuration as it was before the
+buffer was displayed. Temporary buffers can also be killed with the
+usual commands like @code{kill-buffer}, in which case the previous
+window configuration won't be restored.
+
+Pressing @kbd{RET} is supposed to ``do the most obvious useful
+thing.'' For instance, in an apropos buffer this prints a full
+description of the symbol at point, and in an @acronym{XREF} buffer it
+displays the source code for the reference at point. This convention
+is inherited from Emacs's own buffers for apropos listings,
+compilation results, etc.
+
+Temporary buffers containing Lisp symbols use @code{slime-mode} in
+addition to any special mode of their own. This makes the usual
+ at SLIME{} commands available for describing symbols, looking up
+function definitions, and so on.
+
+ at c ----------------------- 
+ at node Inferior-lisp
+ at subsection @code{*inferior-lisp*} buffer
+
+ at SLIME{} internally uses the @code{comint} package to start Lisp
+processes. This has a few user-visible consequences, some good and
+some not-so-terribly. To avoid confusion it is useful to understand
+the interactions.
+
+The buffer @code{*inferior-lisp*} contains the Lisp process's own
+top-level. This direct access to Lisp is useful for troubleshooting,
+and some degree of @SLIME{} integration is available using the
+ at code{inferior-slime-mode}. However, in normal use we recommend using
+the fully-integrated @SLIME{} @REPL{} and ignoring the
+ at code{*inferior-lisp*} buffer.
+
+ at c ----------------------- 
+ at node Multithreading
+ at subsection Multithreading
+
+If the Lisp system supports multithreading, SLIME spawns a new thread
+for each request, e.g., @kbd{C-x C-e} creates a new thread to evaluate
+the expression.  An exception to this rule are requests from the
+ at REPL{}: all commands entered in the @REPL{} buffer are evaluated in a
+dedicated @REPL{} thread.
+
+Some complications arise with multithreading and special variables.
+Non-global special bindings are thread-local, e.g., changing the value
+of a let bound special variable in one thread has no effect on the
+binding of the variables with the same name in other threads.  This
+makes it sometimes difficult to change the printer or reader behaviour
+for new threads.  The variable
+ at code{swank:*default-worker-thread-bindings*} was introduced for such
+situtuations: instead of modifying the global value of a variable, add a
+binding the @code{swank:*default-worker-thread-bindings*}.  E.g., with
+the following code, new threads will read floating point values as
+doubles by default:
+
+ at example
+(push '(*read-default-float-format* . double-float)
+       swank:*default-worker-thread-bindings*).
+ at end example
+
+ at c ----------------------- 
+ at node Key bindings
+ at section Key bindings
+
+ at quotation
+ at i{``Are you deliberately spiting Emacs's brilliant online help facilities? The gods will be angry!''}
+ at end quotation
+
+ at noindent This is a brilliant piece of advice. The Emacs online help facilities
+are your most immediate, up-to-date and complete resource for keybinding
+information. They are your friends:
+
+ at table @kbd
+ at kbdanchorc{C-h k <key>, describe-key, ``What does this key do?''} 
+Describes current function bound to @kbd{<key>} for focus buffer. 
+
+ at kbdanchorc{C-h b, describe-bindings, ``Exactly what bindings are available?''} 
+Lists the current key-bindings for the focus buffer. 
+
+ at kbdanchorc{C-h m, describe-mode, ``Tell me all about this mode''}
+Shows all the available major mode keys, then the minor mode keys, for
+the modes of the focus buffer.
+
+ at kbdanchorc{C-h l, view-lossage, ``Woah at comma{} what key chord did I just do?''} 
+Shows you the literal sequence of keys you've pressed in order. 
+
+
+ at c <key> is breaks links PDF, despite that it's not l it's C-h
+ at c @kbdanchorc{ <key> l, , ``What starts with?''} 
+ at c Lists all keybindings that begin with @code{<key>} for the focus buffer mode. 
+
+
+ at end table
+
+ at emph{Note:} In this documentation the designation @kbd{C-h} is a
+ at dfn{cannonical key} which might actually mean Ctrl-h, or F1, or
+whatever you have @code{help-command} bound to in your
+ at code{.emacs}. Here is a common situation:
+
+ at example
+(global-set-key [f1]   'help-command)
+(global-set-key "\C-h" 'delete-backward-char)
+ at end example
+
+ at noindent In this situation everywhere you see @kbd{C-h} in the 
+documentation you would substitute @kbd{F1}.
+
+In general we try to make our key bindings fit with the overall Emacs
+style. We also have the following somewhat unusual convention of our
+own: when entering a three-key sequence, the final key can be pressed
+either with control or unmodified. For example, the
+ at code{slime-describe-symbol} command is bound to @kbd{C-c C-d d}, but
+it also works to type @kbd{C-c C-d C-d}. We're simply binding both key
+sequences because some people like to hold control for all three keys
+and others don't, and with the two-key prefix we're not afraid of
+running out of keys.
+
+There is one exception to this rule, just to trip you up. We never
+bind @kbd{C-h} anywhere in a key sequence, so @kbd{C-c C-d C-h}
+doesn't do the same thing as @kbd{C-c C-d h}. This is because Emacs
+has a built-in default so that typing a prefix followed by @kbd{C-h}
+will display all bindings starting with that prefix, so @kbd{C-c C-d
+C-h} will actually list the bindings for all documentation commands.
+This feature is just a bit too useful to clobber!
+
+You can assign or change default key bindings globally using the
+ at code{global-set-key} function in your @file{~/.emacs} file like this:
+ at example
+(global-set-key "\C-c s" 'slime-selector)
+ at end example
+ at noindent
+which binds @kbd{C-c s} to the function @code{slime-selector}.
+
+Alternatively, if you want to assign or change a key binding in just a
+particular slime mode, you can use the @code{global-set-key} function
+in your @file{~/.emacs} file like this:
+ at example
+(define-key slime-repl-mode-map (kbd "C-c ;") 
+            'slime-insert-balanced-comments)
+ at end example
+ at noindent
+which binds @kbd{C-c ;} to the function
+ at code{slime-insert-balanced-comments} in the REPL buffer.
+
+ at c ----------------------- 
+ at node Commands
+ at section Commands
+
+ at acronym{SLIME} commands are divided into the following general
+categories: @strong{Programming, Compilation, Evaluation, Recovery,
+Inspector, and Profiling}, discussed in separate sections below. There
+are also comprehensive indices to commands by function 
+(@pxref{Command Index}).
+
+ at menu
+* Programming::                 
+* Compilation::                 
+* Evaluation::                  
+* Recovery::                    
+* Inspector::                   
+* Profiling::                   
+* Other::                       
+ at end menu
+
+ at c ----------------------- 
+ at node Programming
+ at subsection Programming commands
+
+Programming commands are divided into the following categories:
+ at strong{Completion, Documentation, Cross-reference, Finding
+definitions, Macro-expansion, and Disassembly}, discussed in
+separate sections below.
+
+ at menu
+* Completion::                  
+* Closure::                     
+* Indentation::                 
+* Documentation::               
+* Cross-reference::             
+* Finding definitions::         
+* Macro-expansion::             
+* Disassembly::                 
+ at end menu
+
+ at c ----------------------- 
+ at node Completion
+ at subsubsection Completion commands
+
+Completion commands are used to complete a symbol or form based on
+what is already present at point. Classical completion assumes an
+exact prefix and gives choices only where branches may occur. Fuzzy
+completion tries harder.
+
+ at table @kbd
+ at kbditem{M-TAB,slime-complete-symbol}
+ at itemx ESC TAB
+ at itemx C-c C-i
+ at itemx C-M-i
+Complete the symbol at point. Note that three styles of completion are
+available in @SLIME{}, and the default differs from normal Emacs
+completion (@pxref{slime-complete-symbol-function}).
+
+ at kbditem{C-c C-s, slime-complete-form} 
+Looks up and inserts into the current buffer the argument list for the
+function at point, if there is one.  More generally, the command
+completes an incomplete form with a template for the missing arguments.
+There is special code for discovering extra keywords of generic
+functions and for handling @code{make-instance} and
+ at code{defmethod}. Examples:
+
+ at example
+(subseq "abc" <C-c C-s>
+  --inserts--> start [end])
+(find 17 <C-c C-s>
+  --inserts--> sequence :from-end from-end :test test
+               :test-not test-not :start start :end end 
+               :key key)
+(find 17 '(17 18 19) :test #'= <C-c C-s>
+  --inserts--> :from-end from-end
+               :test-not test-not :start start :end end 
+               :key key)
+(defclass foo () ((bar :initarg :bar)))
+(defmethod print-object <C-c C-s>
+  --inserts-->   (object stream)
+               body...)
+(defmethod initialize-instance :after ((object foo) &key blub))
+(make-instance 'foo <C-c C-s>
+  --inserts--> :bar bar :blub blub initargs...)
+ at end example
+
+ at anchor{slime-fuzzy-complete-symbol}
+ at kbditem{C-c M-i, slime-fuzzy-complete-symbol}
+Presents a list of likely completions to choose from for an
+abbreviation at point.  This is a third completion method and it is
+very different from the more traditional completion to which
+ at command{slime-complete-symbol} defaults.  It attempts to complete a
+symbol all at once, instead of in pieces.  For example, ``mvb'' will
+find ``@code{multiple-value-bind}'' and ``norm-df'' will find
+``@code{least-positive-normalized-double-float}''.  This can also be
+selected as the method of completion used for
+ at code{slime-complete-symbol}.
+
+ at cmditem{slime-fuzzy-completions-mode}
+ at cmditem{slime-fuzzy-abort}
+ at end table
+
+
+ at c ----------------------- 
+ at node Closure
+ at subsubsection Closure commands
+
+Closure commands are used to fill in missing parenthesis.  
+
+ at table @kbd
+ at kbditem{C-c C-q, slime-close-parens-at-point}
+Closes parentheses at point to complete the top-level-form by inserting ')'
+characters at until @code{beginning-of-defun} and @code{end-of-defun}
+execute without errors, or @code{slime-close-parens-limit} is exceeded.
+
+ at kbditem{C-], slime-close-all-sexp}
+Balance parentheses of open s-expressions at point.
+Insert enough right-parentheses to balance unmatched left-parentheses.
+Delete extra left-parentheses.  Reformat trailing parentheses 
+Lisp-stylishly.
+
+If @code{REGION} is true, operate on the region. Otherwise operate on
+the top-level sexp before point.
+ at end table
+
+
+ at c ----------------------- 
+ at node Indentation
+ at subsubsection Indentation commands
+
+ at table @kbd
+ at kbditem{C-c M-q, slime-reindent-defun}
+Re-indents the current defun, or refills the current paragraph.
+If point is inside a comment block, the text around point will be
+treated as a paragraph and will be filled with @code{fill-paragraph}.
+Otherwise, it will be treated as Lisp code, and the current defun
+will be reindented.  If the current defun has unbalanced parens,
+an attempt will be made to fix it before reindenting.
+
+ at kbditem{C-M-q, indent-sexp}
+Indents the list immediately following point to match the level at point. 
+
+When given a prefix argument, the text around point will always
+be treated as a paragraph.  This is useful for filling docstrings."
+ at end table
+
+
+ at c ----------------------- 
+ at node Documentation
+ at subsubsection Documentation commands
+
+ at SLIME{}'s online documentation commands follow the example of Emacs
+Lisp. The commands all share the common prefix @kbd{C-c C-d} and allow
+the final key to be modified or unmodified (@pxref{Key bindings}.)
+
+ at table @kbd
+
+ at kbditem{SPC, slime-space}
+The space key inserts a space, but also looks up and displays the
+argument list for the function at point, if there is one.
+
+ at kbditem{C-c C-d d, slime-describe-symbol}
+Describe the symbol at point.
+
+ at kbditem{C-c C-f, slime-describe-function}
+Describe the function at point.
+
+ at kbditem{C-c C-d a, slime-apropos}
+Perform an apropos search on Lisp symbol names for a regular expression
+match and display their documentation strings. By default the external
+symbols of all packages are searched. With a prefix argument you can choose a
+specific package and whether to include unexported symbols.
+
+ at kbditem{C-c C-d z, slime-apropos-all}
+Like @code{slime-apropos} but also includes internal symbols by default.
+
+ at kbditem{C-c C-d p, slime-apropos-package}
+Show apropos results of all symbols in a package. This command is for
+browsing a package at a high-level. With package-name completion it
+also serves as a rudimentary Smalltalk-ish image-browser.
+
+ at kbditem{C-c C-d h, slime-hyperspec-lookup}
+Lookup the symbol at point in the @cite{Common Lisp Hyperspec}. This
+uses the familiar @file{hyperspec.el} to show the appropriate section
+in a web browser. The Hyperspec is found either on the Web or in
+ at code{common-lisp-hyperspec-root}, and the browser is selected by
+ at code{browse-url-browser-function}.
+
+Note: this is one case where @kbd{C-c C-d h} is @emph{not} the same as
+ at kbd{C-c C-d C-h}.
+
+ at kbditem{C-c C-d ~, common-lisp-hyperspec-format}
+Lookup a @emph{format character} in the @cite{Common Lisp Hyperspec}.
+ at end table
+
+
+ at c ----------------------- 
+ at node Cross-reference
+ at subsubsection Cross-reference commands
+
+ at SLIME{}'s cross-reference commands are based on the support provided
+by the Lisp system, which varies widely between Lisps. For systems
+with no built-in @acronym{XREF} support @SLIME{} queries a portable
+ at acronym{XREF} package, which is taken from the @cite{CMU AI
+Repository} and bundled with @SLIME{}.
+
+Each command operates on the symbol at point, or prompts if there is
+none. With a prefix argument they always prompt. You can either enter
+the key bindings as shown here or with the control modified on the
+last key, @xref{Key bindings}.
+
+ at table @kbd
+ at kbditem{C-c C-w c, slime-who-calls}
+Show function callers.
+
+ at kbditem{C-c C-w w, slime-calls-who}
+Show all known callees.
+
+ at kbditem{C-c C-w r, slime-who-references}
+Show references to global variable.
+
+ at kbditem{C-c C-w b, slime-who-binds}
+Show bindings of a global variable.
+
+ at kbditem{C-c C-w s, slime-who-sets}
+Show assignments to a global variable.
+
+ at kbditem{C-c C-w m, slime-who-macroexpands}
+Show expansions of a macro.
+
+ at cmditem{slime-who-specializes}
+Show all known methods specialized on a class.
+
+ at end table
+
+There are also ``List callers/callees'' commands. These operate by
+rummaging through function objects on the heap at a low-level to
+discover the call graph. They are only available with some Lisp
+systems, and are most useful as a fallback when precise @acronym{XREF}
+information is unavailable.
+
+ at table @kbd
+ at kbditem{C-c <, slime-list-callers}
+List callers of a function.
+
+ at kbditem{C-c >, slime-list-callees}
+List callees of a function.
+
+ at end table
+
+
+
+ at c ----------------------- 
+ at node Finding definitions
+ at subsubsection Finding definitions (``Meta-Point'' commands).
+
+The familiar @kbd{M-.} command is provided. For generic functions this
+command finds all methods, and with some systems it does other fancy
+things (like tracing structure accessors to their @code{DEFSTRUCT}
+definition).
+
+ at table @kbd
+
+ at kbditem{M-., slime-edit-definition}
+Go to the definition of the symbol at point.
+
+ at item M-,
+ at itemx M-*
+ at itemx M-x slime-pop-find-definition-stack
+ at kindex M-,
+ at findex slime-pop-find-definition-stack
+Go back to the point where @kbd{M-.} was invoked. This gives multi-level
+backtracking when @kbd{M-.} has been used several times.
+
+ at kbditem{C-x 4 ., slime-edit-definition-other-window}
+Like @code{slime-edit-definition} but switchs to the other window to
+edit the definition in.
+
+ at kbditem{C-x 5 ., slime-edit-definition-other-frame}
+Like @code{slime-edit-definition} but opens another frame to edit the
+definition in.
+
+ at cmditem{slime-edit-definition-with-etags}
+Use an ETAGS table to find definition at point.
+
+ at end table
+
+ at c ----------------------- 
+ at node Macro-expansion
+ at subsubsection Macro-expansion commands
+
+ at table @kbd
+ at kbditem{C-c C-m, slime-macroexpand-1}
+Macroexpand the expression at point once.  If invoked with a prefix
+argument, use macroexpand instead of macroexpand-1.
+
+ at kbditem{C-c M-m, slime-macroexpand-all}
+Fully macroexpand the expression at point.
+
+ at cmditem{slime-compiler-macroexpand-1}
+Display the compiler-macro expansion of sexp at point.
+
+ at cmditem{slime-compiler-macroexpand}
+Repeatedy expamd compiler macros of sexp at point.
+
+ at end table
+
+For additional minor-mode commands and discussion,
+ at pxref{slime-macroexpansion-minor-mode}.
+
+
+ at c ----------------------- 
+ at node Disassembly
+ at subsubsection Disassembly commands
+
+ at table @kbd
+
+ at kbditem{C-c M-d, slime-disassemble-symbol}
+Disassemble the function definition of the symbol at point.
+
+ at kbditem{C-c C-t, slime-toggle-trace-fdefinition}
+Toggle tracing of the function at point.  If invoked with a prefix
+argument, read additional information, like which particular method
+should be traced.
+
+ at cmditem{slime-untrace-all}
+Untrace all functions.
+
+ at end table
+
+ at c ----------------------- 
+ at node Compilation
+ at subsection Compilation commands
+
+ at SLIME{} has fancy commands for compiling functions, files, and
+packages. The fancy part is that notes and warnings offered by the
+Lisp compiler are intercepted and annotated directly onto the
+corresponding expressions in the Lisp source buffer. (Give it a try to
+see what this means.)
+
+ at table @kbd
+ at kbditem{C-c C-c, slime-compile-defun}
+Compile the top-level form at point.
+ at cindex compiling functions
+
+ at kbditem{C-c C-y, slime-call-defun}
+Insert a call to the function defined around point into the REPL.
+
+ at kbditem{C-c C-k, slime-compile-and-load-file}
+Compile and load the current buffer's source file.
+
+ at kbditem{C-c M-k, slime-compile-file}
+Compile (but don't load) the current buffer's source file.
+
+ at kbditem{C-c C-l, slime-load-file}
+Load a source file and compile if necessary, without loading into a buffer..
+
+ at kbditem{C-c C-z, slime-switch-to-output-buffer}
+Select the output buffer, preferably in a different window.
+
+ at cmditem{slime-compile-region}
+Compile region at point.
+
+ at end table
+
+The annotations are indicated as underlining on source forms. The
+compiler message associated with an annotation can be read either by
+placing the mouse over the text or with the selection commands below.
+
+ at table @kbd
+ at kbditem{M-n, slime-next-note}
+Move the point to the next compiler note and displays the note.
+
+ at kbditem{M-p, slime-previous-note}
+Move the point to the previous compiler note and displays the note.
+
+ at kbditem{C-c M-c, slime-remove-notes}
+Remove all annotations from the buffer.
+ at end table
+
+ at c ----------------------- 
+ at node Evaluation
+ at subsection Evaluation commands
+
+These commands each evaluate a Lisp expression in a different way. By
+default they show their results in a message, but a prefix argument
+causes the results to be printed in the @REPL{} instead.
+
+ at table @kbd
+
+ at kbditem{C-M-x, slime-eval-defun}
+Evaluate the current toplevel form.
+Use @code{slime-re-evaluate-defvar} if the from starts with @code{(defvar}.
+
+ at kbditem{C-x C-e, slime-eval-last-expression}
+Evaluate the expression before point.
+ at end table
+
+If @kbd{C-M-x} or @kbd{C-x C-e} is given a numeric argument, it inserts the
+value into the current buffer at point, rather than displaying it in the
+echo area.
+
+ at table @kbd
+ at kbditem{C-c C-p, slime-pprint-eval-last-expression}
+Evaluate the expression before point and pretty-print the result.
+
+ at kbditem{C-c C-r, slime-eval-region}
+Evaluate the region.
+
+ at kbditem{C-x M-e, slime-eval-last-expression-display-output}
+Display output buffer and evaluate the expression preceding point.
+
+ at kbditem{C-c :, slime-interactive-eval}
+Evaluate an expression read from the minibuffer.
+
+ at anchor{slime-scratch}
+ at cmditem{slime-scratch}
+Create a @file{*slime-scratch*} buffer. In this
+buffer you can enter Lisp expressions and evaluate them with
+ at kbd{C-j}, like in Emacs's @file{*scratch*} buffer.
+
+ at kbditem{C-c E, slime-edit-value}
+Edit the value of a setf-able form in a new buffer @file{*Edit <form>*}.
+The value is inserted into a temporary buffer for editing and then set
+in Lisp when committed with @code{slime-edit-value-commit}.
+
+ at kbditem{C-c C-u, slime-undefine-function}
+Unbind symbol for function at point.
+ at end table
+
+
+ at c ----------------------- 
+ at node Recovery
+ at subsection Abort/Recovery commands
+
+ at table @kbd
+ at kbditem{C-c C-b, slime-interrupt}
+Interrupt Lisp (send @code{SIGINT}).
+
+ at kbditem{C-c ~, slime-sync-package-and-default-directory}
+Synchronize the current package and working directory from Emacs to
+Lisp.
+
+ at kbditem{C-c M-p, slime-repl-set-package}
+Set the current package of the @acronym{REPL}.
+
+ at end table
+
+ at c ----------------------- 
+ at node Inspector
+ at subsection Inspector commands
+
+The @SLIME{} inspector is a very fancy Emacs-based alternative to the
+standard @code{INSPECT} function. The inspector presents objects in
+Emacs buffers using a combination of plain text, hyperlinks to related
+objects, and ``actions'' that can be selected to invoke Lisp code on
+the inspected object. For example, to present a generic function the
+inspector shows the documentation in plain text and presents each
+method with both a hyperlink to inspect the method object and a
+``remove method'' action that you can invoke interactively.
+
+The inspector can easily be specialized for the objects in your own
+programs. For details see the the @code{inspect-for-emacs} generic
+function in @file{swank-backend.lisp}.
+
+ at table @kbd
+
+ at kbditem{C-c I, slime-inspect}
+Inspect the value of an expression entered in the minibuffer.
+
+ at end table
+
+The standard commands available in the inspector are:
+
+ at table @kbd
+
+ at kbditem{RET, slime-inspector-operate-on-point} 
+If point is on a value then recursivly call the inspcetor on that
+value. If point is on an action then call that action.
+
+ at kbditem{d, slime-inspector-describe}
+Describe the slot at point.
+
+ at kbditem{l, slime-inspector-pop}
+Go back to the previous object (return from @kbd{RET}).
+
+ at kbditem{n, slime-inspector-next}
+The inverse of @kbd{l}. Also bound to @kbd{SPC}.
+
+ at kbditem{q, slime-inspector-quit}
+Dismiss the inspector buffer.
+
+ at kbditem{M-RET, slime-inspector-copy-down} 
+Evaluate the value under point via the REPL (to set `*').
+
+ at end table
+
+ at c ----------------------- 
+ at node Profiling
+ at subsection Profiling commands
+
+ at table @kbd
+ at cmditem{slime-toggle-profile-fdefinition}
+Toggle profiling of a function.
+ at cmditem{slime-profile-package}
+Profile all functions in a package.
+ at cmditem{slime-unprofile-all}
+Unprofile all functions.
+ at cmditem{slime-profile-report}
+Report profiler data.
+ at cmditem{slime-profile-reset}
+Reset profiler data.
+ at cmditem{slime-profiled-functions}
+Show list of currently profiled functions.
+ at end table
+
+ at c ----------------------- 
+ at node Other
+ at subsection Shadowed Commands
+
+ at table @kbd
+
+ at kbditempair{C-c C-a, C-c C-v, slime-nop, slime-nop}
+This key-binding is shadowed from inf-lisp.
+
+ at end table
+
+ at c ----------------------- 
+ at node Semantic indentation
+ at section Semantic indentation
+
+ at SLIME{} automatically discovers how to indent the macros in your Lisp
+system. To do this the Lisp side scans all the macros in the system and
+reports to Emacs all the ones with @code{&body} arguments. Emacs then
+indents these specially, putting the first arguments four spaces in and
+the ``body'' arguments just two spaces, as usual.
+
+This should ``just work.'' If you are a lucky sort of person you needn't
+read the rest of this section.
+
+To simplify the implementation, @SLIME{} doesn't distinguish between
+macros with the same symbol-name but different packages. This makes it
+fit nicely with Emacs's indentation code. However, if you do have
+several macros with the same symbol-name then they will all be indented
+the same way, arbitrarily using the style from one of their
+arglists. You can find out which symbols are involved in collisions
+with:
+
+ at example
+(swank:print-indentation-lossage)
+ at end example
+
+If a collision causes you irritation, don't have a nervous breakdown,
+just override the Elisp symbol's @code{common-lisp-indent-function}
+property to your taste. @SLIME{} won't override your custom settings, it
+just tries to give you good defaults.
+
+A more subtle issue is that imperfect caching is used for the sake of
+performance. @footnote{@emph{Of course} we made sure it was actually too
+slow before making the ugly optimization.}
+
+In an ideal world, Lisp would automatically scan every symbol for
+indentation changes after each command from Emacs. However, this is too
+expensive to do every time. Instead Lisp usually just scans the symbols
+whose home package matches the one used by the Emacs buffer where the
+request comes from. That is sufficient to pick up the indentation of
+most interactively-defined macros. To catch the rest we make a full scan
+of every symbol each time a new Lisp package is created between commands
+-- that takes care of things like new systems being loaded.
+
+You can use @kbd{M-x slime-update-indentation} to force all symbols to
+be scanned for indentation information.
+
+ at c ----------------------- 
+ at node Reader conditionals
+ at section Reader conditional fontification
+
+ at SLIME{} automatically evaluates reader-conditional expressions in
+source buffers and ``grays out'' code that will be skipped for the
+current Lisp connection.
+
+
+ at c ----------------------- 
+ at node REPL
+ at chapter REPL: the ``top level''
+
+ at SLIME{} uses a custom Read-Eval-Print Loop (@REPL{}, also known as a
+``top level''). The @REPL{} user-interface is written in Emacs Lisp,
+which gives more Emacs-integration than the traditional
+ at code{comint}-based Lisp interaction:
+
+ at itemize @bullet
+ at item
+Conditions signalled in @REPL{} expressions are debugged with @SLDB{}.
+ at item
+Return values are distinguished from printed output by separate Emacs
+faces (colours).
+ at item
+Emacs manages the @REPL{} prompt with markers. This ensures that Lisp
+output is inserted in the right place, and doesn't get mixed up with
+user input.
+ at end itemize
+
+ at menu
+* REPL commands::               
+* Input Navigation::            
+* Shortcuts::                   
+ at end menu
+
+ at c ----------------------- 
+ at node REPL commands
+ at section REPL commands
+
+ at table @kbd
+
+ at kbditem{RET, slime-repl-return}
+Evaluate the current input in Lisp if it is complete. If incomplete,
+open a new line and indent. If a prefix argument is given then the
+input is evaluated without checking for completeness.
+
+ at kbditem{C-RET, slime-repl-closing-return}
+Close any unmatched parenthesis and then evaluate the current input in
+Lisp. Also bound to @kbd{M-RET}.
+
+ at kbditem{C-j, slime-repl-newline-and-indent}
+Open and indent a new line.
+
+ at c @anchor{slime-interrupt}
+ at kbditem{C-c C-c, slime-interrupt}
+Interrupt the Lisp process with @code{SIGINT}.
+
+ at kbditem{C-c M-g, slime-quit}
+Quit slime. 
+
+ at kbditem{C-c C-o, slime-repl-clear-output}
+Remove the output and result of the previous expression from the
+buffer.
+
+ at kbditem{C-c C-t, slime-repl-clear-buffer}
+Clear the entire buffer, leaving only a prompt.
+
+ at end table
+
+ at c ----------------------- 
+ at node Input Navigation
+ at section Input navigation
+
+ at table @kbd
+
+ at kbditem{C-a, slime-repl-bol}
+Go to the beginning of the line, but stop at the @REPL{} prompt.
+
+ at kbditempair{M-n, M-p, slime-repl-next-input, slime-repl-previous-input}
+Go to next/previous in command history.
+
+ at kbditempair{M-s, M-r, 
+slime-repl-next-matching-input, slime-repl-previous-matching-input}
+Search forward/reverse through command history with regex
+
+ at c @code{slime-repl-@{next,previous@}-input}@*
+ at c @code{slime-repl-@{next,previous@}-matching-input}@*
+ at c @code{comint}-style input history commands.
+
+ at kbditempair{C-c C-n, C-c C-p, 
+slime-repl-next-prompt, slime-repl-previous-prompt}
+Move between the current and previous prompts in the @REPL{} buffer.
+
+ at kbditempair{C-M-a, C-M-e, 
+slime-repl-beginning-of-defun, slime-repl-end-of-defun}
+These commands are like @code{beginning-of-defun} and
+ at code{end-of-defun}, but when used inside the @REPL{} input area they
+instead go directly to the beginning or the end, respectively.
+
+ at end table
+
+ at c ----------------------- 
+ at comment  node-name,  next,  previous,  up
+ at node Shortcuts
+ at section Shortcuts
+
+``Shortcuts'' are a special set of @REPL{} commands that are invoked
+by name. To invoke a shortcut you first press @kbd{,} (comma) at the
+ at REPL{} prompt and then enter the shortcut's name when prompted.
+
+Shortcuts deal with things like switching between directories and
+compiling and loading Lisp systems. The set of shortcuts is listed
+below, and you can also use the @code{help}
+shortcut to list them interactively.
+
+ at table @kbd
+ at item change-directory (aka !d, cd)
+Change the current directory.
+
+ at item change-package (aka !p)
+Change the current package.
+
+ at item compile-and-load (aka cl)
+Compile (if neccessary) and load a lisp file.
+
+ at item compile-system
+Compile (but not load) an ASDF system.
+
+ at item defparameter (aka !)
+Define a new global, special, variable.
+
+ at item force-compile-system
+Recompile (but not load) an ASDF system.
+
+ at item force-load-system
+Recompile and load an ASDF system.
+
+ at item help (aka ?)
+Display the help.
+
+ at item load-system
+Compile (as needed) and load an ASDF system.
+
+ at item pop-directory (aka -d)
+Pop the current directory.
+
+ at item pop-package (aka -p)
+Pop the top of the package stack.
+
+ at item push-directory (aka +d, pushd)
+Push a new directory onto the directory stack.
+
+ at item push-package (aka +p)
+Push a package onto the package stack.
+
+ at item pwd
+Show the current directory.
+
+ at item quit
+Quit the current Lisp.
+
+ at item resend-form
+Resend the last form.
+
+ at item restart-inferior-lisp
+Restart *inferior-lisp* and reconnect SLIME.
+
+ at item sayoonara
+Quit all Lisps and close all SLIME buffers.
+
+ at end table
+
+ at c ----------------------- 
+ at node Debugger
+ at chapter SLDB: the SLIME debugger
+
+ at SLIME{} has a custom Emacs-based debugger called @SLDB{}. Conditions
+signalled in the Lisp system invoke @SLDB{} in Emacs by way of the
+Lisp @code{*DEBUGGER-HOOK*}.
+
+ at SLDB{} pops up a buffer when a condition is signalled. The buffer
+displays a description of the condition, a list of restarts, and a
+backtrace. Commands are offered for invoking restarts, examining the
+backtrace, and poking around in stack frames.
+
+ at menu
+* Examining frames::            
+* Restarts::                    
+* Frame Navigation::            
+* Miscellaneous::               
+ at end menu
+
+ at c ----------------------- 
+ at node Examining frames
+ at section Examining frames
+
+Commands for examining the stack frame at point.
+
+ at table @kbd
+ at kbditem{t, sldb-toggle-details}
+Toggle display of local variables and @code{CATCH} tags.
+
+ at kbditem{v, sldb-show-source}
+View the frame's current source expression. The expression is
+presented in the Lisp source file's buffer.
+
+ at kbditem{e, sldb-eval-in-frame}
+Evaluate an expression in the frame. The expression can refer to the
+available local variables in the frame.
+
+ at kbditem{d, sldb-pprint-eval-in-frame}
+Evaluate an expression in the frame and pretty-print the result in a
+temporary buffer.
+
+ at kbditem{D, sldb-disassemble}
+Disassemble the frame's function. Includes information such as the
+instruction pointer within the frame.
+
+ at kbditem{i, sldb-inspect-in-frame}
+Inspect the result of evaluating an expression in the frame.
+ at end table
+
+ at c ----------------------- 
+ at node Restarts
+ at section Invoking restarts
+
+ at table @kbd
+ at kbditem{a, sldb-abort}
+Invoke the @code{ABORT} restart.
+
+ at kbditem{q, sldb-quit}
+``Quit'' -- @code{THROW} to a tag that the top-level @SLIME{}
+request-loop catches.
+
+ at kbditem{c, sldb-continue}
+Invoke the @code{CONTINUE} restart.
+
+ at item 0 ... 9
+Invoke a restart by number.
+ at end table
+
+Restarts can also be invoked by pressing @kbd{RET} or @kbd{Mouse-2} on
+them in the buffer.
+
+ at c ----------------------- 
+ at node Frame Navigation
+ at section Navigating between frames
+
+ at table @kbd
+ at kbditempair{n,p,sldb-down,sldb-up}
+Move between frames.
+
+ at kbditempair{M-n, M-p, sldb-details-down, sldb-details-up}
+Move between frames ``with sugar'': hide the details of the original
+frame and display the details and source code of the next. Sugared
+motion makes you see the details and source code for the current frame
+only.
+ at end table
+
+ at c ----------------------- 
+ at node Miscellaneous
+ at section Miscellaneous Commands
+
+ at table @kbd
+ at kbditem{r, sldb-restart-frame}
+Restart execution of the frame with the same arguments it was
+originally called with. (This command is not available in all
+implementations.)
+
+ at kbditem{R, sldb-return-from-frame}
+Return from the frame with a value entered in the minibuffer. (This
+command is not available in all implementations.)
+
+ at kbditem{s, sldb-step}
+Step to the next expression in the frame. (This command is not
+available in all implementations.)
+
+ at kbditem{B, sldb-break-with-default-debugger}
+Exit @SLDB{} and debug the condition using the Lisp system's default
+debugger.
+
+ at kbditem{C-c :, slime-interactive-eval}
+Evaluate an expression entered in the minibuffer.
+ at end table
+
+
+ at c ----------------------- 
+ at node Extras
+ at chapter Extras
+
+ at menu
+* slime-selector::              
+* slime-autodoc-mode::          
+* slime-macroexpansion-minor-mode::  
+* Multiple connections::        
+* Typeout frames::              
+ at end menu
+
+ at c ----------------------- 
+ at node slime-selector
+ at section @code{slime-selector}
+
+The @code{slime-selector} command is for quickly switching to
+important buffers: the @REPL{}, @SLDB{}, the Lisp source you were just
+hacking, etc. Once invoked the command prompts for a single letter to
+specify which buffer it should display. Here are some of the options:
+
+ at table @kbd
+ at item ?
+A help buffer listing all @code{slime-selectors}'s available buffers.
+ at item r
+The @REPL{} buffer for the current @SLIME{} connection.
+ at item d
+The most recently activated @SLDB{} buffer for the current connection.
+ at item l
+The most recently visited @code{lisp-mode} source buffer.
+ at item s
+The @code{*slime-scratch*} buffer (@pxref{slime-scratch}).
+ at end table
+
+ at code{slime-selector} doesn't have a key binding by default but we
+suggest that you assign it a global one. You can bind it to @kbd{C-c s}
+like this:
+
+ at example
+(global-set-key "\C-cs" 'slime-selector)
+ at end example
+
+ at noindent
+And then you can switch to the @REPL{} from anywhere with @kbd{C-c s
+r}.
+
+The macro @code{def-slime-selector-method} can be used to define new
+buffers for @code{slime-selector} to find.
+
+ at c ----------------------- 
+ at node slime-autodoc-mode
+ at section @code{slime-autodoc-mode}
+
+ at table @kbd
+ at cmditem{slime-autodoc-mode}
+Autodoc mode is an additional minor-mode for automatically showing
+information about symbols near the point. For function names the
+argument list is displayed, and for global variables, the value. 
+This is a clone of @code{eldoc-mode} for Emacs Lisp.
+ at end table
+
+The mode can be enabled by default in the @code{slime-setup} call of your
+ at code{~/.emacs}:
+ at example
+(slime-setup '(slime-autodoc))
+ at end example
+
+ at c ----------------------- 
+ at node slime-macroexpansion-minor-mode
+ at section slime-macroexpansion-minor-mode
+
+Within a slime macroexpansion buffer some extra commands are provided
+(these commands are always available but are only bound to keys in a
+macroexpansion buffer).
+
+ at table @kbd
+ at kbditem{C-c C-m, slime-macroexpand-1-inplace}
+Just like slime-macroexpand-1 but the original form is replaced with
+the expansion.
+
+ at c @anchor{slime-macroexpand-1-inplace}
+ at kbditem{g, slime-macroexpand-1-inplace}
+The last macroexpansion is performed again, the current contents of
+the macroexpansion buffer are replaced with the new expansion.
+
+ at kbditem{q, slime-temp-buffer-quit}
+Close the expansion buffer.
+
+ at end table
+
+ at c ----------------------- 
+ at node Multiple connections
+ at section Multiple connections
+
+ at SLIME{} is able to connect to multiple Lisp processes at the same
+time. The @kbd{M-x slime} command, when invoked with a prefix
+argument, will offer to create an additional Lisp process if one is
+already running. This is often convenient, but it requires some
+understanding to make sure that your @SLIME{} commands execute in the
+Lisp that you expect them to.
+
+Some buffers are tied to specific Lisp processes. Each Lisp connection
+has its own @acronym{REPL} buffer, and all expressions entered or
+ at SLIME{} commands invoked in that buffer are sent to the associated
+connection. Other buffers created by @SLIME{} are similarly tied to
+the connections they originate from, including @SLDB{} buffers,
+apropos result listings, and so on. These buffers are the result of
+some interaction with a Lisp process, so commands in them always go
+back to that same process.
+
+Commands executed in other places, such as @code{slime-mode} source
+buffers, always use the ``default'' connection. Usually this is the
+most recently established connection, but this can be reassigned via
+the ``connection list'' buffer:
+
+ at table @kbd
+ at kbditem{C-c C-x c, slime-list-connections}
+Pop up a buffer listing the established connections.
+
+ at kbditem{C-c C-x t, slime-list-threads}
+Pop up a buffer listing the current threads.
+
+ at end table
+
+The buffer displayed by @code{slime-list-connections} gives a one-line
+summary of each connection. The summary shows the connection's serial
+number, the name of the Lisp implementation, and other details of the
+Lisp process. The current ``default'' connection is indicated with an
+asterisk.
+
+The commands available in the connection-list buffer are:
+
+ at table @kbd
+ at kbditem{RET, slime-goto-connection}
+Pop to the @acronym{REPL} buffer of the connection at point.
+
+ at kbditem{d, slime-connection-list-make-default}
+Make the connection at point the ``default'' connection. It will then
+be used for commands in @code{slime-mode} source buffers.
+
+ at kbditem{g, slime-update-connection-list}
+Update the connection list in the buffer.
+
+ at kbditem{q, slime-temp-buffer-quit}
+Quit the connection list (kill buffer, restore window configuration).
+
+ at kbditem{R, slime-restart-connection-at-point}
+Restart the Lisp process for the connection at point.
+
+ at cmditem{slime-connect}
+Connect to a running Swank server.
+
+ at cmditem{slime-disconnect}
+Disconnect all connections.
+
+ at cmditem{slime-abort-connection}
+Abort the current attempt to connect.
+
+ at end table
+
+ at c ----------------------- 
+ at node Typeout frames
+ at section Typeout frames
+
+A ``typeout frame'' is a special Emacs frame which is used instead of
+the echo area (minibuffer) to display messages from @SLIME{} commands.
+This is an optional feature. The advantage of a typeout frame over the
+echo area is that it can hold more text, it can be scrolled, and its
+contents don't disappear when you press a key. All potentially long
+messages are sent to the typeout frame, such as argument lists, macro
+expansions, and so on.
+
+ at table @kbd
+ at cmditem{slime-ensure-typeout-frame}
+Ensure that a typeout frame exists, creating one if necessary.
+ at end table
+
+If the typeout frame is closed then the echo area will be used again
+as usual.
+
+To have a typeout frame created automatically at startup you can add
+the @code{slime-connected-hook} to your @file{~/.emacs} file:
+
+ at example
+(add-hook 'slime-connected-hook 'slime-ensure-typeout-frame)
+ at end example
+
+ at c ----------------------- 
+ at node Customization
+ at chapter Customization
+
+ at menu
+* Emacs-side customization::    
+* Lisp-side::                   
+ at end menu
+
+ at c ----------------------- 
+ at node Emacs-side customization
+ at section Emacs-side
+
+The Emacs part of @SLIME{} can be configured with the Emacs
+ at code{customize} system, just use @kbd{M-x customize-group slime
+RET}. Because the customize system is self-describing, we only cover a
+few important or obscure configuration options here in the manual.
+
+ at table @code
+
+ at item slime-truncate-lines
+The value to use for @code{truncate-lines} in line-by-line summary
+buffers popped up by @SLIME{}. This is @code{t} by default, which
+ensures that lines do not wrap in backtraces, apropos listings, and so
+on. It can however cause information to spill off the screen.
+
+ at anchor{slime-complete-symbol-function}
+ at vindex slime-complete-symbol-function
+ at item slime-complete-symbol-function
+The function to use for completion of Lisp symbols. Three completion
+styles are available. The default @code{slime-complete-symbol*}
+performs completion ``in parallel'' over the hyphen-delimited
+sub-words of a symbol name.
+ at footnote{This style of completion is modelled on @file{completer.el}
+by Chris McConnell. That package is bundled with @acronym{ILISP}.}
+Formally this means that ``@code{a-b-c}'' can complete to any symbol
+matching the regular expression ``@code{^a.*-b.*-c.*}'' (where ``dot''
+matches anything but a hyphen). Examples give a more intuitive
+feeling:
+ at itemize @bullet
+ at item
+ at code{m-v-b} completes to @code{multiple-value-bind}.
+ at item
+ at code{w-open} is ambiguous: it completes to either
+ at code{with-open-file} or @code{with-open-stream}. The symbol is
+expanded to the longest common completion (@code{with-open-}) and the
+point is placed at the first point of ambiguity, which in this case is
+the end.
+ at item
+ at code{w--stream} completes to @code{with-open-stream}.
+ at end itemize
+An alternative is @code{slime-simple-complete-symbol}, which
+completes in the usual Emacs way.  Finally, there is
+ at code{slime-fuzzy-complete-symbol}, which is quite different from both
+of the above and tries to find best matches to an abbreviated symbol.
+It also has its own key binding, defaulting to @kbd{C-c M-i}.
+ at xref{slime-fuzzy-complete-symbol}, for more information.
+
+ at vindex slime-filename-translations
+ at item slime-filename-translations
+This variable controls filename translation between Emacs and the Lisp
+system. It is useful if you run Emacs and Lisp on separate machines
+which don't share a common file system or if they share the filessytem
+but have different layouts, as is the case with @acronym{SMB}-based
+file sharing.
+
+ at vindex slime-net-coding-system
+ at item slime-net-coding-system
+If you want to transmit Unicode characters between Emacs and the Lisp
+system, you should customize this variable.  E.g., if you use SBCL, you
+can set:
+ at example
+(setq slime-net-coding-system 'utf-8-unix)
+ at end example
+To actually display Unicode characters you also need appropriate fonts,
+otherwise the characters will be rendered as hollow boxes.  If you are
+using Allegro CL and GNU Emacs, you can also use @code{emacs-mule-unix}
+as coding system.  GNU Emacs has often nicer fonts for the latter
+encoding.
+
+ at end table
+
+ at menu
+* Hooks::                       
+ at end menu
+
+ at c ----------------------- 
+ at node Hooks
+ at subsection Hooks
+
+ at table @code
+
+ at vindex slime-mode-hook
+ at item slime-mode-hook
+This hook is run each time a buffer enters @code{slime-mode}. It is
+most useful for setting buffer-local configuration in your Lisp source
+buffers. An example use is to enable @code{slime-autodoc-mode}
+(@pxref{slime-autodoc-mode}).
+
+ at vindex slime-connected-hook
+ at item slime-connected-hook
+This hook is run when @SLIME{} establishes a connection to a Lisp
+server. An example use is to create a Typeout frame (@xref{Typeout frames}.)
+
+ at vindex sldb-hook
+ at item sldb-hook
+This hook is run after @SLDB{} is invoked. The hook functions are
+called from the @SLDB{} buffer after it is initialized. An example use
+is to add @code{sldb-print-condition} to this hook, which makes all
+conditions debugged with @SLDB{} be recorded in the @REPL{} buffer.
+
+ at end table
+
+ at c ----------------------- 
+ at node Lisp-side
+ at section Lisp-side (Swank)
+
+The Lisp server side of @SLIME{} (known as ``Swank'') offers several
+variables to configure. The initialization file @file{~/.swank.lisp}
+is automatically evaluated at startup and can be used to set these
+variables.
+
+ at menu
+* Communication style::         
+* Other configurables::         
+ at end menu
+
+ at c ----------------------- 
+ at node Communication style
+ at subsection Communication style
+ at vindex SWANK:*COMMUNICATION-STYLE*
+
+The most important configurable is @code{SWANK:*COMMUNICATION-STYLE*},
+which specifies the mechanism by which Lisp reads and processes
+protocol messages from Emacs. The choice of communication style has a
+global influence on @SLIME{}'s operation.
+
+The available communication styles are:
+
+ at table @code
+ at item NIL
+This style simply loops reading input from the communication socket
+and serves @SLIME{} protocol events as they arise. The simplicity
+means that the Lisp cannot do any other processing while under
+ at SLIME{}'s control.
+
+ at item :FD-HANDLER
+This style uses the classical Unix-style ``@code{select()}-loop.''
+Swank registers the communication socket with an event-dispatching
+framework (such as @code{SERVE-EVENT} in @acronym{CMUCL} and
+ at acronym{SBCL}) and receives a callback when data is available. In
+this style requests from Emacs are only detected and processed when
+Lisp enters the event-loop. This style is simple and predictable.
+
+ at item :SIGIO
+This style uses @dfn{signal-driven I/O} with a @code{SIGIO} signal
+handler. Lisp receives requests from Emacs along with a signal,
+causing it to interrupt whatever it is doing to serve the
+request. This style has the advantage of responsiveness, since Emacs
+can perform operations in Lisp even while it is busy doing other
+things. It also allows Emacs to issue requests concurrently, e.g. to
+send one long-running request (like compilation) and then interrupt
+that with several short requests before it completes. The
+disadvantages are that it may conflict with other uses of @code{SIGIO}
+by Lisp code, and it may cause untold havoc by interrupting Lisp at an
+awkward moment.
+
+ at item :SPAWN
+This style uses multiprocessing support in the Lisp system to execute
+each request in a separate thread. This style has similar properties
+to @code{:SIGIO}, but it does not use signals and all requests issued
+by Emacs can be executed in parallel.
+
+ at end table
+
+The default request handling style is chosen according to the
+capabilities of your Lisp system. The general order of preference is
+ at code{:SPAWN}, then @code{:SIGIO}, then @code{:FD-HANDLER}, with
+ at code{NIL} as a last resort. You can check the default style by
+calling @code{SWANK-BACKEND:PREFERRED-COMMUNICATION-STYLE}. You can
+also override the default by setting
+ at code{SWANK:*COMMUNICATION-STYLE*} in your Swank init file.
+
+ at c ----------------------- 
+ at node Other configurables
+ at subsection Other configurables
+
+These Lisp variables can be configured via your @file{~/.swank.lisp}
+file:
+
+ at table @code
+
+ at vindex SWANK:*CONFIGURE-EMACS-INDENTATION*
+ at item SWANK:*CONFIGURE-EMACS-INDENTATION*
+This variable controls whether indentation styles for
+ at code{&body}-arguments in macros are discovered and sent to Emacs. It
+is enabled by default.
+
+ at vindex SWANK:*GLOBALLY-REDIRECT-IO*
+ at item SWANK:*GLOBALLY-REDIRECT-IO*
+When true this causes the standard streams (@code{*standard-output*},
+etc) to be globally redirected to the @REPL{} in Emacs. When
+ at code{NIL} (the default) these streams are only temporarily redirected
+to Emacs using dynamic bindings while handling requests. Note that
+ at code{*standard-input*} is currently never globally redirected into
+Emacs, because it can interact badly with the Lisp's native @REPL{} by
+having it try to read from the Emacs one.
+
+ at vindex SWANK:*GLOBAL-DEBUGGER*
+ at item SWANK:*GLOBAL-DEBUGGER*
+When true (the default) this causes @code{*DEBUGGER-HOOK*} to be
+globally set to @code{SWANK:SWANK-DEBUGGER-HOOK} and thus for @SLIME{}
+to handle all debugging in the Lisp image. This is for debugging
+multithreaded and callback-driven applications.
+
+ at vindex SWANK:*SLDB-PRINTER-BINDINGS*
+ at vindex SWANK:*MACROEXPAND-PRINTER-BINDINGS*
+ at vindex SWANK:*SWANK-PPRINT-BINDINGS*
+ at item SWANK:*SLDB-PRINTER-BINDINGS*
+ at itemx SWANK:*MACROEXPAND-PRINTER-BINDINGS*
+ at itemx SWANK:*SWANK-PPRINT-BINDINGS*
+These variables can be used to customize the printer in various
+situations.  The values of the variables are association lists of
+printer variable names with the corresponding value.  E.g., to enable
+the pretty printer for formatting backtraces in @SLDB{}, you can use:
+ at example
+(push '(*print-pretty* . t) swank:*sldb-printer-bindings*).
+ at end example
+
+ at vindex SWANK:*USE-DEDICATED-OUTPUT-STREAM*
+ at item SWANK:*USE-DEDICATED-OUTPUT-STREAM*
+This variable controls whether to use an unsafe efficiency hack for
+sending printed output from Lisp to Emacs.  The default is @code{nil},
+don't use it, and is strongly recommended to keep.
+
+When @code{t}, a separate socket is established solely for Lisp to send
+printed output to Emacs through, which is faster than sending the output
+in protocol-messages to Emacs.  However, as nothing can be guaranteed
+about the timing between the dedicated output stream and the stream of
+protocol messages, the output of a Lisp command can arrive before or
+after the corresponding REPL results.  Thus output and REPL results can
+end up in the wrong order, or even interleaved, in the REPL buffer.
+Using a dedicated output stream also makes it more difficult to
+communicate to a Lisp running on a remote host via SSH
+(@pxref{Connecting to a remote lisp}).  
+
+ at vindex SWANK:*DEDICATED-OUTPUT-STREAM-PORT*
+ at item SWANK:*DEDICATED-OUTPUT-STREAM-PORT*
+When @code{*USE-DEDICATED-OUTPUT-STREAM*} is @code{t} the stream will
+be opened on this port. The default value, @code{0}, means that the
+stream will be opened on some random port.
+
+ at vindex SWANK:*LOG-EVENTS*
+ at item SWANK:*LOG-EVENTS*
+Setting this variable to @code{t} causes all protocol messages
+exchanged with Emacs to be printed to @code{*TERMINAL-IO*}. This is
+useful for low-level debugging and for observing how @SLIME{} works
+``on the wire.'' The output of @code{*TERMINAL-IO*} can be found in
+your Lisp system's own listener, usually in the buffer
+ at code{*inferior-lisp*}.
+
+ at end table
+
+ at c ----------------------- 
+ at node Tips and Tricks
+ at chapter Tips and Tricks
+
+ at menu
+* Connecting to a remote lisp::  
+* Global IO Redirection::       
+* Auto-SLIME::                  
+ at end menu
+
+ at c ----------------------- 
+ at node Connecting to a remote lisp
+ at section Connecting to a remote lisp
+
+One of the advantages of the way @SLIME{} is implemented is that we
+can easily run the Emacs side (slime.el) on one machine and the lisp
+backend (swank) on another. The basic idea is to start up lisp on the
+remote machine, load swank and wait for incoming slime connections. On
+the local machine we start up emacs and tell slime to connect to the
+remote machine. The details are a bit messier but the underlying idea
+is that simple.
+
+ at menu
+* Setting up the lisp image::   
+* Setting up Emacs::            
+* Setting up pathname translations::  
+ at end menu
+
+ at c ----------------------- 
+ at node Setting up the lisp image
+ at subsection Setting up the lisp image
+
+
+When you want to load swank without going through the normal, Emacs
+based, process just load the @file{swank-loader.lisp} file. Just
+execute
+
+ at example
+(load "/path/to/swank-loader.lisp")
+ at end example
+
+inside a running lisp image at footnote{@SLIME{} also provides an
+ at acronym{ASDF} system definiton which does the same thing}. Now all we
+need to do is startup our swank server. The first example assumes we're
+using the default settings.
+
+ at example
+(swank:create-server)
+ at end example
+
+Since we're going to be tunneling our connection via
+ssh at footnote{there is a way to connect without an ssh tunnel, but it
+has the side-effect of giving the entire world access to your lisp
+image, so we're not going to talk about it} and we'll only have one
+port open we want to tell swank to not use an extra connection for
+output (this is actually the default in current SLIME):
+
+ at example
+(setf swank:*use-dedicated-output-stream* nil)
+ at end example
+
+ at c ----------------------- 
+If you need to do anything particular
+(like be able to reconnect to swank after you're done), look into
+ at code{swank:create-server}'s other arguments. Some of these arguments
+are
+ at table @code
+
+ at item :PORT
+Port number for the server to listen on (default: 4005).
+ at item :STYLE
+See @xref{Communication style}.
+ at item :DONT-CLOSE
+Boolean indicating if the server will continue to accept connections
+after the first one (default: @code{NIL}). For ``long-running'' lisp processes
+to which you want to be able to connect from time to time,
+specify @code{:dont-close t}
+ at item :CODING-SYSTEM
+String designating the encoding to be used to communicate between the
+Emacs and Lisp.
+ at end table
+
+So the more complete example will be
+ at example
+(swank:create-server :port 4005  :dont-close t :coding-system "utf-8-unix")
+ at end example
+On the emacs side you will use something like
+ at example
+(setq slime-net-coding-system 'utf-8-unix)
+(slime-connect "127.0.0.1" 4005))
+ at end example
+to connect to this lisp image from the same machine.
+
+
+ at node Setting up Emacs
+ at subsection Setting up Emacs
+
+Now we need to create the tunnel between the local machine and the
+remote machine.
+
+ at example
+ssh -L4005:127.0.0.1:4005 username@@remote.example.com
+ at end example
+
+That ssh invocation creates an ssh tunnel between the port 4005 on our
+local machine and the port 4005 on the remote machine at footnote{By
+default swank listens for incoming connections on port 4005, had we
+passed a @code{:port} parameter to @code{swank:create-server} we'd be
+using that port number instead}. 
+
+Finally we can start @SLIME{}:
+
+ at example
+M-x slime-connect RET RET
+ at end example
+
+The @kbd{RET RET} sequence just means that we want to use the default
+host (@code{127.0.0.1}) and the default port (@code{4005}). Even
+though we're connecting to a remote machine the ssh tunnel fools Emacs
+into thinking it's actually @code{127.0.0.1}.
+
+ at c ----------------------- 
+ at node Setting up pathname translations
+ at subsection Setting up pathname translations
+
+One of the main problems with running swank remotely is that Emacs
+assumes the files can be found using normal filenames. if we want
+things like @code{slime-compile-and-load-file} (@kbd{C-c C-k}) and
+ at code{slime-edit-definition} (@kbd{M-.}) to work correctly we need to
+find a way to let our local Emacs refer to remote files.
+
+There are, mainly, two ways to do this. The first is to mount, using
+NFS or similar, the remote machine's hard disk on the local machine's
+file system in such a fashion that a filename like
+ at file{/opt/project/source.lisp} refers to the same file on both
+machines. Unfortunetly NFS is usually slow, often buggy, and not
+always feasable, fortunetely we have an ssh connection and Emacs'
+ at code{tramp-mode} can do the rest.
+
+What we do is teach Emacs how to take a filename on the remote machine
+and translate it into something that tramp can understand and access
+(and vice-versa). Assuming the remote machine's host name is
+ at code{remote.example.com}, @code{cl:machine-instance} returns
+``remote'' and we login as the user ``user'' we can use @SLIME{}'s
+built-in mechanism to setup the proper transaltions by simply doing:
+
+ at example
+(push (slime-create-filename-translator :machine-instance "remote.example.com"
+                                        :remote-host "remote"
+                                        :username "user")
+      slime-filename-translations)
+ at end example
+
+ at c ----------------------- 
+ at node Global IO Redirection
+ at section Globally redirecting all IO to the REPL
+
+By default @SLIME{} does not change @code{*standard-output*} and
+friends outside of the @REPL{}. If you have any other threads which
+call @code{format}, @code{write-string}, etc. that output will be seen
+only in the @code{*inferior-lisp*} buffer or on the terminal, more
+often than not this is inconvenient. So, if you want code such as this:
+
+ at example
+(run-in-new-thread
+  (lambda ()
+    (write-line "In some random thread.~%" *standard-output*)))
+ at end example
+
+to send its output to @SLIME{}'s repl buffer, as opposed to
+ at code{*inferior-lisp*}, set @code{swank:*globally-redirect-io*} to T.
+
+Note that the value of this variable is only checked when swank
+accepts the connection so you should set it via
+ at file{~/.swank.lisp}. Otherwise you will need to call
+ at code{swank::globally-redirect-io-to-connection} yourself, but you
+shouldn't do that unless you know what you're doing.
+
+ at c ----------------------- 
+ at node Auto-SLIME
+ at section Connecting to SLIME automatically
+
+To make @SLIME{} connect to your lisp whenever you open a lisp file
+just add this to your @file{.emacs}:
+
+ at example
+(add-hook 'slime-mode-hook
+          (lambda ()
+            (unless (slime-connected-p)
+              (save-excursion (slime)))))
+ at end example
+
+
+ at c ----------------------- 
+ at node Credits
+ at chapter Credits
+
+ at emph{The soppy ending...}
+
+ at unnumberedsec Hackers of the good hack
+
+ at SLIME{} is an Extension of @acronym{SLIM} by Eric Marsden. At the
+time of writing, the authors and code-contributors of @SLIME{} are:
+
+ at include contributors.texi
+
+... not counting the bundled code from @file{hyperspec.el},
+ at cite{CLOCC}, and the @cite{CMU AI Repository}.
+
+Many people on the @code{slime-devel} mailing list have made non-code
+contributions to @SLIME{}. Life is hard though: you gotta send code to
+get your name in the manual. @code{:-)}
+
+ at unnumberedsec Thanks!
+
+We're indebted to the good people of @code{common-lisp.net} for their
+hosting and help, and for rescuing us from ``Sourceforge hell.''
+
+Implementors of the Lisps that we support have been a great help. We'd
+like to thank the @acronym{CMUCL} maintainers for their helpful
+answers, Craig Norvell and Kevin Layer at Franz providing Allegro CL
+licenses for @SLIME{} development, and Peter Graves for his help to
+get @SLIME{} running with @acronym{ABCL}.
+
+Most of all we're happy to be working with the Lisp implementors
+who've joined in the @SLIME{} development: Dan Barlow and Christophe
+Rhodes of @acronym{SBCL}, Gary Byers of OpenMCL, and Martin Simmons of
+LispWorks. Thanks also to Alain Picard and Memetrics for funding
+Martin's initial work on the LispWorks backend!
+
+ at ignore 
+This index is currently ingored, because texinfo's built-in indexing
+produces nicer results.  -- Helmut Eller
+
+ at node Index to Functions
+ at appendix Index to Functions
+
+These functions are all available (when relevant). To find the
+keybinding (if there is one) refer to the function description. 
+
+ at c Note to editors: @fcnindex{...} lines commented out below are place holders
+ at c ----------------
+ at c They have yet to be documented
+ at c Please feel free to add descriptions in the text where appropriate, add the
+ at c appropriate anchors and uncomment them.
+ at c
+ at c [jkc]
+
+ at table @code
+ at fcnindex{common-lisp-hyperspec-format}
+ at fcnindex{sldb-abort}
+ at c @fcnindex{sldb-activate}
+ at c @fcnindex{sldb-add-face}
+ at c @fcnindex{sldb-backward-frame}
+ at c @fcnindex{sldb-beginning-of-backtrace}
+ at c @fcnindex{sldb-break}
+ at c @fcnindex{sldb-break-on-return}
+ at fcnindex{sldb-break-with-default-debugger}
+ at c @fcnindex{sldb-buffers}
+ at c @fcnindex{sldb-catch-tags}
+ at fcnindex{sldb-continue}
+ at c @fcnindex{sldb-debugged-continuations}
+ at c @fcnindex{sldb-default-action}
+ at c @fcnindex{sldb-default-action/mouse}
+ at c @fcnindex{sldb-delete-overlays}
+ at c @fcnindex{sldb-details-down}
+ at c @fcnindex{sldb-details-up}
+ at fcnindex{sldb-disassemble}
+ at c @fcnindex{sldb-dispatch-extras}
+ at c @fcnindex{sldb-down}
+ at c @fcnindex{sldb-end-of-backtrace}
+ at fcnindex{sldb-eval-in-frame}
+ at c @fcnindex{sldb-exit}
+ at c @fcnindex{sldb-fetch-all-frames}
+ at c @fcnindex{sldb-fetch-more-frames}
+ at c @fcnindex{sldb-find-buffer}
+ at c @fcnindex{sldb-format-reference-node}
+ at c @fcnindex{sldb-format-reference-source}
+ at c @fcnindex{sldb-forward-frame}
+ at c @fcnindex{sldb-frame-details-visible-p}
+ at c @fcnindex{sldb-frame-locals}
+ at c @fcnindex{sldb-frame-number-at-point}
+ at c @fcnindex{sldb-frame-region}
+ at c @fcnindex{sldb-get-buffer}
+ at c @fcnindex{sldb-get-default-buffer}
+ at c @fcnindex{sldb-goto-last-frame}
+ at c @fcnindex{sldb-help-summary}
+ at c @fcnindex{sldb-hide-frame-details}
+ at c @fcnindex{sldb-highlight-sexp}
+ at c @fcnindex{sldb-insert-condition}
+ at c @fcnindex{sldb-insert-frame}
+ at c @fcnindex{sldb-insert-frames}
+ at c @fcnindex{sldb-insert-locals}
+ at c @fcnindex{sldb-insert-references}
+ at c @fcnindex{sldb-insert-restarts}
+ at c @fcnindex{sldb-inspect-condition}
+ at fcnindex{sldb-inspect-in-frame}
+ at c @fcnindex{sldb-inspect-var}
+ at c @fcnindex{sldb-invoke-restart}
+ at c @fcnindex{sldb-level}
+ at c @fcnindex{sldb-list-catch-tags}
+ at c @fcnindex{sldb-list-locals}
+ at c @fcnindex{sldb-lookup-reference}
+ at c @fcnindex{sldb-maybe-recenter-region}
+ at c @fcnindex{sldb-mode-hook}
+ at c @fcnindex{sldb-next}
+ at c @fcnindex{sldb-out}
+ at fcnindex{sldb-pprint-eval-in-frame}
+ at c @fcnindex{sldb-previous-frame-number}
+ at c @fcnindex{sldb-print-condition}
+ at c @fcnindex{sldb-prune-initial-frames}
+ at fcnindex{sldb-quit}
+ at c @fcnindex{sldb-reference-properties}
+ at c @fcnindex{sldb-restart-at-point}
+ at fcnindex{sldb-restart-frame}
+ at fcnindex{sldb-return-from-frame}
+ at c @fcnindex{sldb-setup}
+ at c @fcnindex{sldb-show-frame-details}
+ at c @fcnindex{sldb-show-frame-source}
+ at fcnindex{sldb-show-source}
+ at fcnindex{sldb-step}
+ at c @fcnindex{sldb-sugar-move}
+ at fcnindex{sldb-toggle-details}
+ at c @fcnindex{sldb-up}
+ at c @fcnindex{sldb-var-number-at-point}
+ at c @fcnindex{sldb-xemacs-emulate-point-entered-hook}
+ at c @fcnindex{sldb-xemacs-post-command-hook}
+
+
+ at c @fcnindex{inferior-slime-closing-return}
+ at c @fcnindex{inferior-slime-indent-line}
+ at c @fcnindex{inferior-slime-mode}
+ at c @fcnindex{inferior-slime-return}
+ at fcnindex{slime-abort-connection}
+ at fcnindex{slime-apropos}
+ at fcnindex{slime-apropos-all}
+ at fcnindex{slime-apropos-package}
+ at c @fcnindex{slime-arglist}
+ at fcnindex{slime-autodoc-mode}
+ at c @fcnindex{slime-autodoc-start-timer}
+ at c @fcnindex{slime-background-activities-enabled-p}
+ at c @fcnindex{slime-background-message}
+ at c @fcnindex{slime-browse-classes}
+ at c @fcnindex{slime-browse-xrefs}
+ at fcnindex{slime-call-defun}
+ at fcnindex{slime-calls-who}
+ at c @fcnindex{slime-check-coding-system}
+ at fcnindex{slime-close-all-sexp}
+ at fcnindex{slime-close-parens-at-point}
+ at fcnindex{slime-compile-and-load-file}
+ at fcnindex{slime-compile-defun}
+ at fcnindex{slime-compile-file}
+ at fcnindex{slime-compile-region}
+ at fcnindex{slime-compiler-macroexpand}
+ at fcnindex{slime-compiler-macroexpand-1}
+ at c @fcnindex{slime-compiler-notes-default-action-or-show-details}
+ at c @fcnindex{slime-compiler-notes-default-action-or-show-details/mouse}
+ at c @fcnindex{slime-compiler-notes-quit}
+ at c @fcnindex{slime-compiler-notes-show-details}
+ at c @fcnindex{slime-complete-form}
+ at fcnindex{slime-complete-symbol}
+ at fcnindex{slime-connect} 
+ at fcnindex{slime-connection-list-make-default}
+ at c @fcnindex{slime-connection-list-mode}
+ at c @fcnindex{slime-copy-presentation-at-point}
+ at fcnindex{slime-describe-function}
+ at fcnindex{slime-describe-symbol}
+ at fcnindex{slime-disassemble-symbol}
+ at fcnindex{slime-disconnect}
+ at c @fcnindex{slime-documentation}
+ at fcnindex{slime-edit-definition}
+ at fcnindex{slime-edit-definition-other-frame}
+ at fcnindex{slime-edit-definition-other-window}
+ at fcnindex{slime-edit-definition-with-etags}
+ at fcnindex{slime-edit-value}
+ at c @fcnindex{slime-edit-value-commit}
+ at c @fcnindex{slime-edit-value-mode}
+ at fcnindex{slime-ensure-typeout-frame}
+ at c @fcnindex{slime-eval-buffer}
+ at fcnindex{slime-eval-defun}
+ at fcnindex{slime-eval-last-expression}
+ at fcnindex{slime-eval-last-expression-display-output}
+ at c @fcnindex{slime-eval-print-last-expression}
+ at fcnindex{slime-eval-region}
+ at fcnindex{slime-fuzzy-abort}
+ at fcnindex{slime-fuzzy-complete-symbol}
+ at fcnindex{slime-fuzzy-completions-mode}
+ at c @fcnindex{slime-fuzzy-next}        
+ at c @fcnindex{slime-fuzzy-prev}        
+ at c @fcnindex{slime-fuzzy-select}      
+ at c @fcnindex{slime-fuzzy-select/mouse}
+ at fcnindex{slime-goto-connection}
+ at fcnindex{slime-goto-xref}
+ at c @fcnindex{slime-handle-repl-shortcut}
+ at c @fcnindex{slime-highlight-notes}
+ at fcnindex{slime-hyperspec-lookup}
+ at c @fcnindex{slime-indent-and-complete-symbol}
+ at c @fcnindex{slime-init-keymaps}
+ at c @fcnindex{slime-insert-arglist}
+ at c @fcnindex{slime-insert-balanced-comments}
+ at fcnindex{slime-inspect}
+ at fcnindex{slime-inspector-copy-down}
+ at fcnindex{slime-inspector-describe}
+ at fcnindex{slime-inspector-next}
+ at c @fcnindex{slime-inspector-next-inspectable-object}
+ at fcnindex{slime-inspector-quit}
+ at c @fcnindex{slime-inspector-reinspect}
+ at fcnindex{slime-interactive-eval}
+ at fcnindex{slime-interrupt}
+ at fcnindex{slime-list-callees}
+ at fcnindex{slime-list-callers}
+ at c @fcnindex{slime-list-compiler-notes}
+ at fcnindex{slime-list-connections}
+ at c @fcnindex{slime-list-repl-shortcuts}
+ at fcnindex{slime-list-threads}
+ at fcnindex{slime-load-file}
+ at c @fcnindex{slime-load-system}
+ at fcnindex{slime-macroexpand-1}
+ at fcnindex{slime-macroexpand-1-inplace}
+ at fcnindex{slime-macroexpand-all}
+ at c @fcnindex{slime-make-default-connection}
+ at c @fcnindex{slime-make-typeout-frame}
+ at fcnindex{slime-mode}
+ at c @fcnindex{slime-next-line/not-add-newlines}
+ at c @fcnindex{slime-next-location}
+ at fcnindex{slime-next-note}
+ at fcnindex{slime-nop}
+ at c @fcnindex{slime-ping}
+ at fcnindex{slime-pop-find-definition-stack}
+ at fcnindex{slime-pprint-eval-last-expression}
+ at c @fcnindex{slime-presentation-menu}
+ at c @fcnindex{slime-pretty-lambdas}
+ at fcnindex{slime-previous-note}
+ at fcnindex{slime-profile-package}
+ at fcnindex{slime-profile-report}
+ at fcnindex{slime-profile-reset}
+ at fcnindex{slime-profiled-functions}
+ at fcnindex{slime-quit}
+ at c @fcnindex{slime-quit-connection-at-point}
+ at c @fcnindex{slime-quit-lisp}
+ at c @fcnindex{slime-re-evaluate-defvar}
+ at c @fcnindex{slime-recompile-bytecode}
+ at c @fcnindex{slime-register-lisp-implementation}
+ at fcnindex{slime-reindent-defun}
+ at c @fcnindex{slime-remove-balanced-comments}
+ at fcnindex{slime-remove-notes}
+ at c @fcnindex{slime-repl}
+ at fcnindex{slime-repl-beginning-of-defun}
+ at fcnindex{slime-repl-bol}
+ at fcnindex{slime-repl-clear-buffer}
+ at fcnindex{slime-repl-clear-output}
+ at fcnindex{slime-repl-closing-return}
+ at c @fcnindex{slime-repl-compile-and-load}
+ at c @fcnindex{slime-repl-compile-system}
+ at c @fcnindex{slime-repl-compile/force-system}
+ at c @fcnindex{slime-repl-defparameter}
+ at fcnindex{slime-repl-end-of-defun}
+ at c @fcnindex{slime-repl-eol}
+ at c @fcnindex{slime-repl-load-system}
+ at c @fcnindex{slime-repl-load/force-system}
+ at c @fcnindex{slime-repl-mode}
+ at fcnindex{slime-repl-newline-and-indent}
+ at fcnindex{slime-repl-next-input}
+ at fcnindex{slime-repl-next-matching-input}
+ at fcnindex{slime-repl-next-prompt}
+ at c @fcnindex{slime-repl-pop-directory}
+ at c @fcnindex{slime-repl-pop-packages}
+ at fcnindex{slime-repl-previous-input}
+ at fcnindex{slime-repl-previous-matching-input}
+ at fcnindex{slime-repl-previous-prompt}
+ at c @fcnindex{slime-repl-push-directory}
+ at c @fcnindex{slime-repl-push-package}
+ at c @fcnindex{slime-repl-read-break}
+ at c @fcnindex{slime-repl-read-mode}
+ at fcnindex{slime-repl-return}
+ at fcnindex{slime-repl-set-package}
+ at c @fcnindex{slime-repl-shortcut-help}
+ at c @fcnindex{slime-reset}
+ at c @fcnindex{slime-restart-connection-at-point}
+ at c @fcnindex{slime-restart-inferior-lisp}
+ at c @fcnindex{slime-restart-inferior-lisp-aux}
+ at fcnindex{slime-scratch}
+ at c @fcnindex{slime-select-lisp-implementation}
+ at fcnindex{slime-selector}
+ at c @fcnindex{slime-send-sigint}
+ at c @fcnindex{slime-set-default-directory}
+ at c @fcnindex{slime-set-package}
+ at c @fcnindex{slime-show-xref}
+ at fcnindex{slime-space}
+ at c @fcnindex{slime-start-and-load}
+ at fcnindex{slime-switch-to-output-buffer}
+ at fcnindex{slime-sync-package-and-default-directory}
+ at c @fcnindex{slime-temp-buffer-mode}
+ at fcnindex{slime-temp-buffer-quit}
+ at c @fcnindex{slime-thread-attach}
+ at c @fcnindex{slime-thread-debug}
+ at c @fcnindex{slime-thread-control-mode}
+ at c @fcnindex{slime-thread-kill}
+ at c @fcnindex{slime-thread-quit}
+ at fcnindex{slime-toggle-profile-fdefinition}
+ at fcnindex{slime-toggle-trace-fdefinition}
+ at fcnindex{slime-undefine-function}
+ at fcnindex{slime-unprofile-all}
+ at fcnindex{slime-untrace-all}
+ at fcnindex{slime-update-connection-list}
+ at c @fcnindex{slime-update-indentation}                  ???
+ at fcnindex{slime-who-binds}
+ at fcnindex{slime-who-calls}
+ at fcnindex{slime-who-macroexpands}
+ at fcnindex{slime-who-references}
+ at fcnindex{slime-who-sets}
+ at fcnindex{slime-who-specializes}
+ at c @fcnindex{slime-xref-mode}
+ at c @fcnindex{slime-xref-quit}
+ at end table
+
+ at end ignore
+
+ at node Key Index, Command Index, Credits, top
+ at unnumbered Key (Character) Index
+ at printindex ky
+
+ at node Command Index, Variable Index, Key Index, top
+ at unnumbered Command and Function Index
+ at printindex fn
+
+ at node Variable Index, , Command Index, top
+ at unnumbered Variable Index
+ at printindex vr
+
+ at bye

Added: branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk
===================================================================
--- branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/doc/texinfo-tabulate.awk	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,21 @@
+#!/usr/bin/env awk -f
+#
+# Format input lines into a multi-column texinfo table.
+# Note: does not do texinfo-escaping of the input.
+
+# This code has been placed in the Public Domain.  All warranties
+# are disclaimed.
+
+BEGIN {
+  columns = 3;
+  printf("@multitable @columnfractions");
+  for (i = 0; i < columns; i++)
+    printf(" %f", 1.0/columns);
+  print
+}
+
+{ if (NR % columns == 1) printf("\n at item %s", $0);
+  else                   printf(" @tab %s", $0); }
+
+END { printf("\n at end multitable\n"); }
+

Added: branches/trunk-reorg/thirdparty/slime/hyperspec.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/hyperspec.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/hyperspec.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1671 @@
+;;; hyperspec.el --- Browse documentation from the Common Lisp HyperSpec
+
+;; Copyright 1997 Naggum Software
+
+;; Author: Erik Naggum <erik at naggum.no>
+;; Keywords: lisp
+
+;; This file is not part of GNU Emacs, but distributed under the same
+;; conditions as GNU Emacs, and is useless without GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Kent Pitman and Xanalys Inc. have made the text of American National
+;; Standard for Information Technology -- Programming Language -- Common
+;; Lisp, ANSI X3.226-1994 available on the WWW, in the form of the Common
+;; Lisp HyperSpec.  This package makes it convenient to peruse this
+;; documentation from within Emacs.
+
+;;; Code:
+
+(require 'cl)
+(require 'browse-url)                   ;you need the Emacs 20 version
+(require 'thingatpt)
+
+(defvar common-lisp-hyperspec-root
+  "http://www.lispworks.com/reference/HyperSpec/"
+  "The root of the Common Lisp HyperSpec URL.
+If you copy the HyperSpec to your local system, set this variable to
+something like \"file:/usr/local/doc/HyperSpec/\".")
+
+;;; Added variable for CLHS symbol table. See details below.
+;;;
+;;; 20011201 Edi Weitz
+
+(defvar common-lisp-hyperspec-symbol-table nil
+  "The HyperSpec symbol table file.
+If you copy the HyperSpec to your local system, set this variable to
+the location of the symbol table which is usually \"Map_Sym.txt\"
+or \"Symbol-Table.text\".")
+
+(defvar common-lisp-hyperspec-history nil
+  "History of symbols looked up in the Common Lisp HyperSpec.")
+
+;;if only we had had packages or hash tables..., but let's fake it.
+
+(defvar common-lisp-hyperspec-symbols (make-vector 67 0))
+
+(defun common-lisp-hyperspec-strip-cl-package (name)
+  (if (string-match "^\\([^:]*\\)::?\\([^:]*\\)$" name)
+      (let ((package-name (match-string 1 name))
+	    (symbol-name (match-string 2 name)))
+	(if (member (downcase package-name) 
+		    '("cl" "common-lisp"))
+	    symbol-name
+	  name))
+    name))
+
+(defun common-lisp-hyperspec (symbol-name)
+  "View the documentation on SYMBOL-NAME from the Common Lisp HyperSpec.
+If SYMBOL-NAME has more than one definition, all of them are displayed with
+your favorite browser in sequence.  The browser should have a \"back\"
+function to view the separate definitions.
+
+The Common Lisp HyperSpec is the full ANSI Standard Common Lisp, provided
+by Kent Pitman and Xanalys Inc.  By default, the Xanalys Web site is
+visited to retrieve the information.  Xanalys Inc. allows you to transfer
+the entire Common Lisp HyperSpec to your own site under certain conditions.
+Visit http://www.lispworks.com/reference/HyperSpec/ for more information.
+If you copy the HyperSpec to another location, customize the variable
+`common-lisp-hyperspec-root' to point to that location."
+  (interactive (list (let* ((symbol-at-point (thing-at-point 'symbol))
+			    (stripped-symbol 
+			     (and symbol-at-point
+				  (substring-no-properties
+				   (downcase
+				    (common-lisp-hyperspec-strip-cl-package 
+				     symbol-at-point))))))
+                       (if (and stripped-symbol
+                                (intern-soft stripped-symbol
+                                             common-lisp-hyperspec-symbols))
+                           stripped-symbol
+                         (completing-read
+                          "Look up symbol in Common Lisp HyperSpec: "
+                          common-lisp-hyperspec-symbols #'boundp
+                          t stripped-symbol
+                          'common-lisp-hyperspec-history)))))
+  (maplist (lambda (entry)
+             (browse-url (concat common-lisp-hyperspec-root "Body/" (car entry)))
+             (if (cdr entry)
+                 (sleep-for 1.5)))
+           (let ((symbol (intern-soft 
+			  (common-lisp-hyperspec-strip-cl-package 
+			   (downcase symbol-name))
+			  common-lisp-hyperspec-symbols)))
+             (if (and symbol (boundp symbol))
+                 (symbol-value symbol)
+               (error "The symbol `%s' is not defined in Common Lisp"
+                      symbol-name)))))
+
+;;; Added the following just to provide a common entry point according
+;;; to the various 'hyperspec' implementations.
+;;;
+;;; 19990820 Marco Antoniotti
+
+(eval-when (load eval)
+  (defalias 'hyperspec-lookup 'common-lisp-hyperspec))
+
+
+;;; Added dynamic lookup of symbol in CLHS symbol table
+;;;
+;;; 20011202 Edi Weitz
+
+;;; Replaced symbol table for v 4.0 with the one for v 6.0
+;;; (which is now online at Xanalys' site)
+;;;
+;;; 20020213 Edi Weitz
+
+(if common-lisp-hyperspec-symbol-table
+    (let ((index-buffer (find-file-noselect common-lisp-hyperspec-symbol-table)))
+      (labels ((get-one-line ()
+                 (prog1 
+                     (delete* ?\n (thing-at-point 'line))
+                   (forward-line))))
+        (save-excursion
+          (set-buffer index-buffer)
+          (goto-char (point-min))
+          (while (< (point) (point-max))
+            (let* ((symbol (intern (downcase (get-one-line))
+                                   common-lisp-hyperspec-symbols))
+                   (relative-url (get-one-line)))
+              (set symbol (list (subseq relative-url
+                                        (1+ (position ?\/ relative-url :from-end t))))))))))
+  (mapcar (lambda (entry)
+            (let ((symbol (intern (car entry) common-lisp-hyperspec-symbols)))
+              (if (boundp symbol)
+                  (push (cadr entry) (symbol-value symbol))
+                (set symbol (cdr entry)))))
+          '(("&allow-other-keys" "03_da.htm")
+            ("&aux" "03_da.htm")
+            ("&body" "03_dd.htm")
+            ("&environment" "03_dd.htm")
+            ("&key" "03_da.htm")
+            ("&optional" "03_da.htm")
+            ("&rest" "03_da.htm")
+            ("&whole" "03_dd.htm")
+            ("*" "a_st.htm")
+            ("**" "v__stst_.htm")
+            ("***" "v__stst_.htm")
+            ("*break-on-signals*" "v_break_.htm")
+            ("*compile-file-pathname*" "v_cmp_fi.htm")
+            ("*compile-file-truename*" "v_cmp_fi.htm")
+            ("*compile-print*" "v_cmp_pr.htm")
+            ("*compile-verbose*" "v_cmp_pr.htm")
+            ("*debug-io*" "v_debug_.htm")
+            ("*debugger-hook*" "v_debugg.htm")
+            ("*default-pathname-defaults*" "v_defaul.htm")
+            ("*error-output*" "v_debug_.htm")
+            ("*features*" "v_featur.htm")
+            ("*gensym-counter*" "v_gensym.htm")
+            ("*load-pathname*" "v_ld_pns.htm")
+            ("*load-print*" "v_ld_prs.htm")
+            ("*load-truename*" "v_ld_pns.htm")
+            ("*load-verbose*" "v_ld_prs.htm")
+            ("*macroexpand-hook*" "v_mexp_h.htm")
+            ("*modules*" "v_module.htm")
+            ("*package*" "v_pkg.htm")
+            ("*print-array*" "v_pr_ar.htm")
+            ("*print-base*" "v_pr_bas.htm")
+            ("*print-case*" "v_pr_cas.htm")
+            ("*print-circle*" "v_pr_cir.htm")
+            ("*print-escape*" "v_pr_esc.htm")
+            ("*print-gensym*" "v_pr_gen.htm")
+            ("*print-length*" "v_pr_lev.htm")
+            ("*print-level*" "v_pr_lev.htm")
+            ("*print-lines*" "v_pr_lin.htm")
+            ("*print-miser-width*" "v_pr_mis.htm")
+            ("*print-pprint-dispatch*" "v_pr_ppr.htm")
+            ("*print-pretty*" "v_pr_pre.htm")
+            ("*print-radix*" "v_pr_bas.htm")
+            ("*print-readably*" "v_pr_rda.htm")
+            ("*print-right-margin*" "v_pr_rig.htm")
+            ("*query-io*" "v_debug_.htm")
+            ("*random-state*" "v_rnd_st.htm")
+            ("*read-base*" "v_rd_bas.htm")
+            ("*read-default-float-format*" "v_rd_def.htm")
+            ("*read-eval*" "v_rd_eva.htm")
+            ("*read-suppress*" "v_rd_sup.htm")
+            ("*readtable*" "v_rdtabl.htm")
+            ("*standard-input*" "v_debug_.htm")
+            ("*standard-output*" "v_debug_.htm")
+            ("*terminal-io*" "v_termin.htm")
+            ("*trace-output*" "v_debug_.htm")
+            ("+" "a_pl.htm")
+            ("++" "v_pl_plp.htm")
+            ("+++" "v_pl_plp.htm")
+            ("-" "a__.htm")
+            ("/" "a_sl.htm")
+            ("//" "v_sl_sls.htm")
+            ("///" "v_sl_sls.htm")
+            ("/=" "f_eq_sle.htm")
+            ("1+" "f_1pl_1_.htm")
+            ("1-" "f_1pl_1_.htm")
+            ("<" "f_eq_sle.htm")
+            ("<=" "f_eq_sle.htm")
+            ("=" "f_eq_sle.htm")
+            (">" "f_eq_sle.htm")
+            (">=" "f_eq_sle.htm")
+            ("abort" "a_abort.htm")
+            ("abs" "f_abs.htm")
+            ("acons" "f_acons.htm")
+            ("acos" "f_asin_.htm")
+            ("acosh" "f_sinh_.htm")
+            ("add-method" "f_add_me.htm")
+            ("adjoin" "f_adjoin.htm")
+            ("adjust-array" "f_adjust.htm")
+            ("adjustable-array-p" "f_adju_1.htm")
+            ("allocate-instance" "f_alloca.htm")
+            ("alpha-char-p" "f_alpha_.htm")
+            ("alphanumericp" "f_alphan.htm")
+            ("and" "a_and.htm")
+            ("append" "f_append.htm")
+            ("apply" "f_apply.htm")
+            ("apropos" "f_apropo.htm")
+            ("apropos-list" "f_apropo.htm")
+            ("aref" "f_aref.htm")
+            ("arithmetic-error" "e_arithm.htm")
+            ("arithmetic-error-operands" "f_arithm.htm")
+            ("arithmetic-error-operation" "f_arithm.htm")
+            ("array" "t_array.htm")
+            ("array-dimension" "f_ar_dim.htm")
+            ("array-dimension-limit" "v_ar_dim.htm")
+            ("array-dimensions" "f_ar_d_1.htm")
+            ("array-displacement" "f_ar_dis.htm")
+            ("array-element-type" "f_ar_ele.htm")
+            ("array-has-fill-pointer-p" "f_ar_has.htm")
+            ("array-in-bounds-p" "f_ar_in_.htm")
+            ("array-rank" "f_ar_ran.htm")
+            ("array-rank-limit" "v_ar_ran.htm")
+            ("array-row-major-index" "f_ar_row.htm")
+            ("array-total-size" "f_ar_tot.htm")
+            ("array-total-size-limit" "v_ar_tot.htm")
+            ("arrayp" "f_arrayp.htm")
+            ("ash" "f_ash.htm")
+            ("asin" "f_asin_.htm")
+            ("asinh" "f_sinh_.htm")
+            ("assert" "m_assert.htm")
+            ("assoc" "f_assocc.htm")
+            ("assoc-if" "f_assocc.htm")
+            ("assoc-if-not" "f_assocc.htm")
+            ("atan" "f_asin_.htm")
+            ("atanh" "f_sinh_.htm")
+            ("atom" "a_atom.htm")
+            ("base-char" "t_base_c.htm")
+            ("base-string" "t_base_s.htm")
+            ("bignum" "t_bignum.htm")
+            ("bit" "a_bit.htm")
+            ("bit-and" "f_bt_and.htm")
+            ("bit-andc1" "f_bt_and.htm")
+            ("bit-andc2" "f_bt_and.htm")
+            ("bit-eqv" "f_bt_and.htm")
+            ("bit-ior" "f_bt_and.htm")
+            ("bit-nand" "f_bt_and.htm")
+            ("bit-nor" "f_bt_and.htm")
+            ("bit-not" "f_bt_and.htm")
+            ("bit-orc1" "f_bt_and.htm")
+            ("bit-orc2" "f_bt_and.htm")
+            ("bit-vector" "t_bt_vec.htm")
+            ("bit-vector-p" "f_bt_vec.htm")
+            ("bit-xor" "f_bt_and.htm")
+            ("block" "s_block.htm")
+            ("boole" "f_boole.htm")
+            ("boole-1" "v_b_1_b.htm")
+            ("boole-2" "v_b_1_b.htm")
+            ("boole-and" "v_b_1_b.htm")
+            ("boole-andc1" "v_b_1_b.htm")
+            ("boole-andc2" "v_b_1_b.htm")
+            ("boole-c1" "v_b_1_b.htm")
+            ("boole-c2" "v_b_1_b.htm")
+            ("boole-clr" "v_b_1_b.htm")
+            ("boole-eqv" "v_b_1_b.htm")
+            ("boole-ior" "v_b_1_b.htm")
+            ("boole-nand" "v_b_1_b.htm")
+            ("boole-nor" "v_b_1_b.htm")
+            ("boole-orc1" "v_b_1_b.htm")
+            ("boole-orc2" "v_b_1_b.htm")
+            ("boole-set" "v_b_1_b.htm")
+            ("boole-xor" "v_b_1_b.htm")
+            ("boolean" "t_ban.htm")
+            ("both-case-p" "f_upper_.htm")
+            ("boundp" "f_boundp.htm")
+            ("break" "f_break.htm")
+            ("broadcast-stream" "t_broadc.htm")
+            ("broadcast-stream-streams" "f_broadc.htm")
+            ("built-in-class" "t_built_.htm")
+            ("butlast" "f_butlas.htm")
+            ("byte" "f_by_by.htm")
+            ("byte-position" "f_by_by.htm")
+            ("byte-size" "f_by_by.htm")
+            ("caaaar" "f_car_c.htm")
+            ("caaadr" "f_car_c.htm")
+            ("caaar" "f_car_c.htm")
+            ("caadar" "f_car_c.htm")
+            ("caaddr" "f_car_c.htm")
+            ("caadr" "f_car_c.htm")
+            ("caar" "f_car_c.htm")
+            ("cadaar" "f_car_c.htm")
+            ("cadadr" "f_car_c.htm")
+            ("cadar" "f_car_c.htm")
+            ("caddar" "f_car_c.htm")
+            ("cadddr" "f_car_c.htm")
+            ("caddr" "f_car_c.htm")
+            ("cadr" "f_car_c.htm")
+            ("call-arguments-limit" "v_call_a.htm")
+            ("call-method" "m_call_m.htm")
+            ("call-next-method" "f_call_n.htm")
+            ("car" "f_car_c.htm")
+            ("case" "m_case_.htm")
+            ("catch" "s_catch.htm")
+            ("ccase" "m_case_.htm")
+            ("cdaaar" "f_car_c.htm")
+            ("cdaadr" "f_car_c.htm")
+            ("cdaar" "f_car_c.htm")
+            ("cdadar" "f_car_c.htm")
+            ("cdaddr" "f_car_c.htm")
+            ("cdadr" "f_car_c.htm")
+            ("cdar" "f_car_c.htm")
+            ("cddaar" "f_car_c.htm")
+            ("cddadr" "f_car_c.htm")
+            ("cddar" "f_car_c.htm")
+            ("cdddar" "f_car_c.htm")
+            ("cddddr" "f_car_c.htm")
+            ("cdddr" "f_car_c.htm")
+            ("cddr" "f_car_c.htm")
+            ("cdr" "f_car_c.htm")
+            ("ceiling" "f_floorc.htm")
+            ("cell-error" "e_cell_e.htm")
+            ("cell-error-name" "f_cell_e.htm")
+            ("cerror" "f_cerror.htm")
+            ("change-class" "f_chg_cl.htm")
+            ("char" "f_char_.htm")
+            ("char-code" "f_char_c.htm")
+            ("char-code-limit" "v_char_c.htm")
+            ("char-downcase" "f_char_u.htm")
+            ("char-equal" "f_chareq.htm")
+            ("char-greaterp" "f_chareq.htm")
+            ("char-int" "f_char_i.htm")
+            ("char-lessp" "f_chareq.htm")
+            ("char-name" "f_char_n.htm")
+            ("char-not-equal" "f_chareq.htm")
+            ("char-not-greaterp" "f_chareq.htm")
+            ("char-not-lessp" "f_chareq.htm")
+            ("char-upcase" "f_char_u.htm")
+            ("char/=" "f_chareq.htm")
+            ("char<" "f_chareq.htm")
+            ("char<=" "f_chareq.htm")
+            ("char=" "f_chareq.htm")
+            ("char>" "f_chareq.htm")
+            ("char>=" "f_chareq.htm")
+            ("character" "a_ch.htm")
+            ("characterp" "f_chp.htm")
+            ("check-type" "m_check_.htm")
+            ("cis" "f_cis.htm")
+            ("class" "t_class.htm")
+            ("class-name" "f_class_.htm")
+            ("class-of" "f_clas_1.htm")
+            ("clear-input" "f_clear_.htm")
+            ("clear-output" "f_finish.htm")
+            ("close" "f_close.htm")
+            ("clrhash" "f_clrhas.htm")
+            ("code-char" "f_code_c.htm")
+            ("coerce" "f_coerce.htm")
+            ("compilation-speed" "d_optimi.htm")
+            ("compile" "f_cmp.htm")
+            ("compile-file" "f_cmp_fi.htm")
+            ("compile-file-pathname" "f_cmp__1.htm")
+            ("compiled-function" "t_cmpd_f.htm")
+            ("compiled-function-p" "f_cmpd_f.htm")
+            ("compiler-macro" "f_docume.htm")
+            ("compiler-macro-function" "f_cmp_ma.htm")
+            ("complement" "f_comple.htm")
+            ("complex" "a_comple.htm")
+            ("complexp" "f_comp_3.htm")
+            ("compute-applicable-methods" "f_comput.htm")
+            ("compute-restarts" "f_comp_1.htm")
+            ("concatenate" "f_concat.htm")
+            ("concatenated-stream" "t_concat.htm")
+            ("concatenated-stream-streams" "f_conc_1.htm")
+            ("cond" "m_cond.htm")
+            ("condition" "e_cnd.htm")
+            ("conjugate" "f_conjug.htm")
+            ("cons" "a_cons.htm")
+            ("consp" "f_consp.htm")
+            ("constantly" "f_cons_1.htm")
+            ("constantp" "f_consta.htm")
+            ("continue" "a_contin.htm")
+            ("control-error" "e_contro.htm")
+            ("copy-alist" "f_cp_ali.htm")
+            ("copy-list" "f_cp_lis.htm")
+            ("copy-pprint-dispatch" "f_cp_ppr.htm")
+            ("copy-readtable" "f_cp_rdt.htm")
+            ("copy-seq" "f_cp_seq.htm")
+            ("copy-structure" "f_cp_stu.htm")
+            ("copy-symbol" "f_cp_sym.htm")
+            ("copy-tree" "f_cp_tre.htm")
+            ("cos" "f_sin_c.htm")
+            ("cosh" "f_sinh_.htm")
+            ("count" "f_countc.htm")
+            ("count-if" "f_countc.htm")
+            ("count-if-not" "f_countc.htm")
+            ("ctypecase" "m_tpcase.htm")
+            ("debug" "d_optimi.htm")
+            ("decf" "m_incf_.htm")
+            ("declaim" "m_declai.htm")
+            ("declaration" "d_declar.htm")
+            ("declare" "s_declar.htm")
+            ("decode-float" "f_dec_fl.htm")
+            ("decode-universal-time" "f_dec_un.htm")
+            ("defclass" "m_defcla.htm")
+            ("defconstant" "m_defcon.htm")
+            ("defgeneric" "m_defgen.htm")
+            ("define-compiler-macro" "m_define.htm")
+            ("define-condition" "m_defi_5.htm")
+            ("define-method-combination" "m_defi_4.htm")
+            ("define-modify-macro" "m_defi_2.htm")
+            ("define-setf-expander" "m_defi_3.htm")
+            ("define-symbol-macro" "m_defi_1.htm")
+            ("defmacro" "m_defmac.htm")
+            ("defmethod" "m_defmet.htm")
+            ("defpackage" "m_defpkg.htm")
+            ("defparameter" "m_defpar.htm")
+            ("defsetf" "m_defset.htm")
+            ("defstruct" "m_defstr.htm")
+            ("deftype" "m_deftp.htm")
+            ("defun" "m_defun.htm")
+            ("defvar" "m_defpar.htm")
+            ("delete" "f_rm_rm.htm")
+            ("delete-duplicates" "f_rm_dup.htm")
+            ("delete-file" "f_del_fi.htm")
+            ("delete-if" "f_rm_rm.htm")
+            ("delete-if-not" "f_rm_rm.htm")
+            ("delete-package" "f_del_pk.htm")
+            ("denominator" "f_numera.htm")
+            ("deposit-field" "f_deposi.htm")
+            ("describe" "f_descri.htm")
+            ("describe-object" "f_desc_1.htm")
+            ("destructuring-bind" "m_destru.htm")
+            ("digit-char" "f_digit_.htm")
+            ("digit-char-p" "f_digi_1.htm")
+            ("directory" "f_dir.htm")
+            ("directory-namestring" "f_namest.htm")
+            ("disassemble" "f_disass.htm")
+            ("division-by-zero" "e_divisi.htm")
+            ("do" "m_do_do.htm")
+            ("do*" "m_do_do.htm")
+            ("do-all-symbols" "m_do_sym.htm")
+            ("do-external-symbols" "m_do_sym.htm")
+            ("do-symbols" "m_do_sym.htm")
+            ("documentation" "f_docume.htm")
+            ("dolist" "m_dolist.htm")
+            ("dotimes" "m_dotime.htm")
+            ("double-float" "t_short_.htm")
+            ("double-float-epsilon" "v_short_.htm")
+            ("double-float-negative-epsilon" "v_short_.htm")
+            ("dpb" "f_dpb.htm")
+            ("dribble" "f_dribbl.htm")
+            ("dynamic-extent" "d_dynami.htm")
+            ("ecase" "m_case_.htm")
+            ("echo-stream" "t_echo_s.htm")
+            ("echo-stream-input-stream" "f_echo_s.htm")
+            ("echo-stream-output-stream" "f_echo_s.htm")
+            ("ed" "f_ed.htm")
+            ("eighth" "f_firstc.htm")
+            ("elt" "f_elt.htm")
+            ("encode-universal-time" "f_encode.htm")
+            ("end-of-file" "e_end_of.htm")
+            ("endp" "f_endp.htm")
+            ("enough-namestring" "f_namest.htm")
+            ("ensure-directories-exist" "f_ensu_1.htm")
+            ("ensure-generic-function" "f_ensure.htm")
+            ("eq" "f_eq.htm")
+            ("eql" "a_eql.htm")
+            ("equal" "f_equal.htm")
+            ("equalp" "f_equalp.htm")
+            ("error" "a_error.htm")
+            ("etypecase" "m_tpcase.htm")
+            ("eval" "f_eval.htm")
+            ("eval-when" "s_eval_w.htm")
+            ("evenp" "f_evenpc.htm")
+            ("every" "f_everyc.htm")
+            ("exp" "f_exp_e.htm")
+            ("export" "f_export.htm")
+            ("expt" "f_exp_e.htm")
+            ("extended-char" "t_extend.htm")
+            ("fboundp" "f_fbound.htm")
+            ("fceiling" "f_floorc.htm")
+            ("fdefinition" "f_fdefin.htm")
+            ("ffloor" "f_floorc.htm")
+            ("fifth" "f_firstc.htm")
+            ("file-author" "f_file_a.htm")
+            ("file-error" "e_file_e.htm")
+            ("file-error-pathname" "f_file_e.htm")
+            ("file-length" "f_file_l.htm")
+            ("file-namestring" "f_namest.htm")
+            ("file-position" "f_file_p.htm")
+            ("file-stream" "t_file_s.htm")
+            ("file-string-length" "f_file_s.htm")
+            ("file-write-date" "f_file_w.htm")
+            ("fill" "f_fill.htm")
+            ("fill-pointer" "f_fill_p.htm")
+            ("find" "f_find_.htm")
+            ("find-all-symbols" "f_find_a.htm")
+            ("find-class" "f_find_c.htm")
+            ("find-if" "f_find_.htm")
+            ("find-if-not" "f_find_.htm")
+            ("find-method" "f_find_m.htm")
+            ("find-package" "f_find_p.htm")
+            ("find-restart" "f_find_r.htm")
+            ("find-symbol" "f_find_s.htm")
+            ("finish-output" "f_finish.htm")
+            ("first" "f_firstc.htm")
+            ("fixnum" "t_fixnum.htm")
+            ("flet" "s_flet_.htm")
+            ("float" "a_float.htm")
+            ("float-digits" "f_dec_fl.htm")
+            ("float-precision" "f_dec_fl.htm")
+            ("float-radix" "f_dec_fl.htm")
+            ("float-sign" "f_dec_fl.htm")
+            ("floating-point-inexact" "e_floa_1.htm")
+            ("floating-point-invalid-operation" "e_floati.htm")
+            ("floating-point-overflow" "e_floa_2.htm")
+            ("floating-point-underflow" "e_floa_3.htm")
+            ("floatp" "f_floatp.htm")
+            ("floor" "f_floorc.htm")
+            ("fmakunbound" "f_fmakun.htm")
+            ("force-output" "f_finish.htm")
+            ("format" "f_format.htm")
+            ("formatter" "m_format.htm")
+            ("fourth" "f_firstc.htm")
+            ("fresh-line" "f_terpri.htm")
+            ("fround" "f_floorc.htm")
+            ("ftruncate" "f_floorc.htm")
+            ("ftype" "d_ftype.htm")
+            ("funcall" "f_funcal.htm")
+            ("function" "a_fn.htm")
+            ("function-keywords" "f_fn_kwd.htm")
+            ("function-lambda-expression" "f_fn_lam.htm")
+            ("functionp" "f_fnp.htm")
+            ("gcd" "f_gcd.htm")
+            ("generic-function" "t_generi.htm")
+            ("gensym" "f_gensym.htm")
+            ("gentemp" "f_gentem.htm")
+            ("get" "f_get.htm")
+            ("get-decoded-time" "f_get_un.htm")
+            ("get-dispatch-macro-character" "f_set__1.htm")
+            ("get-internal-real-time" "f_get_in.htm")
+            ("get-internal-run-time" "f_get__1.htm")
+            ("get-macro-character" "f_set_ma.htm")
+            ("get-output-stream-string" "f_get_ou.htm")
+            ("get-properties" "f_get_pr.htm")
+            ("get-setf-expansion" "f_get_se.htm")
+            ("get-universal-time" "f_get_un.htm")
+            ("getf" "f_getf.htm")
+            ("gethash" "f_gethas.htm")
+            ("go" "s_go.htm")
+            ("graphic-char-p" "f_graphi.htm")
+            ("handler-bind" "m_handle.htm")
+            ("handler-case" "m_hand_1.htm")
+            ("hash-table" "t_hash_t.htm")
+            ("hash-table-count" "f_hash_1.htm")
+            ("hash-table-p" "f_hash_t.htm")
+            ("hash-table-rehash-size" "f_hash_2.htm")
+            ("hash-table-rehash-threshold" "f_hash_3.htm")
+            ("hash-table-size" "f_hash_4.htm")
+            ("hash-table-test" "f_hash_5.htm")
+            ("host-namestring" "f_namest.htm")
+            ("identity" "f_identi.htm")
+            ("if" "s_if.htm")
+            ("ignorable" "d_ignore.htm")
+            ("ignore" "d_ignore.htm")
+            ("ignore-errors" "m_ignore.htm")
+            ("imagpart" "f_realpa.htm")
+            ("import" "f_import.htm")
+            ("in-package" "m_in_pkg.htm")
+            ("incf" "m_incf_.htm")
+            ("initialize-instance" "f_init_i.htm")
+            ("inline" "d_inline.htm")
+            ("input-stream-p" "f_in_stm.htm")
+            ("inspect" "f_inspec.htm")
+            ("integer" "t_intege.htm")
+            ("integer-decode-float" "f_dec_fl.htm")
+            ("integer-length" "f_intege.htm")
+            ("integerp" "f_inte_1.htm")
+            ("interactive-stream-p" "f_intera.htm")
+            ("intern" "f_intern.htm")
+            ("internal-time-units-per-second" "v_intern.htm")
+            ("intersection" "f_isec_.htm")
+            ("invalid-method-error" "f_invali.htm")
+            ("invoke-debugger" "f_invoke.htm")
+            ("invoke-restart" "f_invo_1.htm")
+            ("invoke-restart-interactively" "f_invo_2.htm")
+            ("isqrt" "f_sqrt_.htm")
+            ("keyword" "t_kwd.htm")
+            ("keywordp" "f_kwdp.htm")
+            ("labels" "s_flet_.htm")
+            ("lambda" "a_lambda.htm")
+            ("lambda-list-keywords" "v_lambda.htm")
+            ("lambda-parameters-limit" "v_lamb_1.htm")
+            ("last" "f_last.htm")
+            ("lcm" "f_lcm.htm")
+            ("ldb" "f_ldb.htm")
+            ("ldb-test" "f_ldb_te.htm")
+            ("ldiff" "f_ldiffc.htm")
+            ("least-negative-double-float" "v_most_1.htm")
+            ("least-negative-long-float" "v_most_1.htm")
+            ("least-negative-normalized-double-float" "v_most_1.htm")
+            ("least-negative-normalized-long-float" "v_most_1.htm")
+            ("least-negative-normalized-short-float" "v_most_1.htm")
+            ("least-negative-normalized-single-float" "v_most_1.htm")
+            ("least-negative-short-float" "v_most_1.htm")
+            ("least-negative-single-float" "v_most_1.htm")
+            ("least-positive-double-float" "v_most_1.htm")
+            ("least-positive-long-float" "v_most_1.htm")
+            ("least-positive-normalized-double-float" "v_most_1.htm")
+            ("least-positive-normalized-long-float" "v_most_1.htm")
+            ("least-positive-normalized-short-float" "v_most_1.htm")
+            ("least-positive-normalized-single-float" "v_most_1.htm")
+            ("least-positive-short-float" "v_most_1.htm")
+            ("least-positive-single-float" "v_most_1.htm")
+            ("length" "f_length.htm")
+            ("let" "s_let_l.htm")
+            ("let*" "s_let_l.htm")
+            ("lisp-implementation-type" "f_lisp_i.htm")
+            ("lisp-implementation-version" "f_lisp_i.htm")
+            ("list" "a_list.htm")
+            ("list*" "f_list_.htm")
+            ("list-all-packages" "f_list_a.htm")
+            ("list-length" "f_list_l.htm")
+            ("listen" "f_listen.htm")
+            ("listp" "f_listp.htm")
+            ("load" "f_load.htm")
+            ("load-logical-pathname-translations" "f_ld_log.htm")
+            ("load-time-value" "s_ld_tim.htm")
+            ("locally" "s_locall.htm")
+            ("log" "f_log.htm")
+            ("logand" "f_logand.htm")
+            ("logandc1" "f_logand.htm")
+            ("logandc2" "f_logand.htm")
+            ("logbitp" "f_logbtp.htm")
+            ("logcount" "f_logcou.htm")
+            ("logeqv" "f_logand.htm")
+            ("logical-pathname" "a_logica.htm")
+            ("logical-pathname-translations" "f_logica.htm")
+            ("logior" "f_logand.htm")
+            ("lognand" "f_logand.htm")
+            ("lognor" "f_logand.htm")
+            ("lognot" "f_logand.htm")
+            ("logorc1" "f_logand.htm")
+            ("logorc2" "f_logand.htm")
+            ("logtest" "f_logtes.htm")
+            ("logxor" "f_logand.htm")
+            ("long-float" "t_short_.htm")
+            ("long-float-epsilon" "v_short_.htm")
+            ("long-float-negative-epsilon" "v_short_.htm")
+            ("long-site-name" "f_short_.htm")
+            ("loop" "m_loop.htm")
+            ("loop-finish" "m_loop_f.htm")
+            ("lower-case-p" "f_upper_.htm")
+            ("machine-instance" "f_mach_i.htm")
+            ("machine-type" "f_mach_t.htm")
+            ("machine-version" "f_mach_v.htm")
+            ("macro-function" "f_macro_.htm")
+            ("macroexpand" "f_mexp_.htm")
+            ("macroexpand-1" "f_mexp_.htm")
+            ("macrolet" "s_flet_.htm")
+            ("make-array" "f_mk_ar.htm")
+            ("make-broadcast-stream" "f_mk_bro.htm")
+            ("make-concatenated-stream" "f_mk_con.htm")
+            ("make-condition" "f_mk_cnd.htm")
+            ("make-dispatch-macro-character" "f_mk_dis.htm")
+            ("make-echo-stream" "f_mk_ech.htm")
+            ("make-hash-table" "f_mk_has.htm")
+            ("make-instance" "f_mk_ins.htm")
+            ("make-instances-obsolete" "f_mk_i_1.htm")
+            ("make-list" "f_mk_lis.htm")
+            ("make-load-form" "f_mk_ld_.htm")
+            ("make-load-form-saving-slots" "f_mk_l_1.htm")
+            ("make-method" "m_call_m.htm")
+            ("make-package" "f_mk_pkg.htm")
+            ("make-pathname" "f_mk_pn.htm")
+            ("make-random-state" "f_mk_rnd.htm")
+            ("make-sequence" "f_mk_seq.htm")
+            ("make-string" "f_mk_stg.htm")
+            ("make-string-input-stream" "f_mk_s_1.htm")
+            ("make-string-output-stream" "f_mk_s_2.htm")
+            ("make-symbol" "f_mk_sym.htm")
+            ("make-synonym-stream" "f_mk_syn.htm")
+            ("make-two-way-stream" "f_mk_two.htm")
+            ("makunbound" "f_makunb.htm")
+            ("map" "f_map.htm")
+            ("map-into" "f_map_in.htm")
+            ("mapc" "f_mapc_.htm")
+            ("mapcan" "f_mapc_.htm")
+            ("mapcar" "f_mapc_.htm")
+            ("mapcon" "f_mapc_.htm")
+            ("maphash" "f_maphas.htm")
+            ("mapl" "f_mapc_.htm")
+            ("maplist" "f_mapc_.htm")
+            ("mask-field" "f_mask_f.htm")
+            ("max" "f_max_m.htm")
+            ("member" "a_member.htm")
+            ("member-if" "f_mem_m.htm")
+            ("member-if-not" "f_mem_m.htm")
+            ("merge" "f_merge.htm")
+            ("merge-pathnames" "f_merge_.htm")
+            ("method" "t_method.htm")
+            ("method-combination" "a_method.htm")
+            ("method-combination-error" "f_meth_1.htm")
+            ("method-qualifiers" "f_method.htm")
+            ("min" "f_max_m.htm")
+            ("minusp" "f_minusp.htm")
+            ("mismatch" "f_mismat.htm")
+            ("mod" "a_mod.htm")
+            ("most-negative-double-float" "v_most_1.htm")
+            ("most-negative-fixnum" "v_most_p.htm")
+            ("most-negative-long-float" "v_most_1.htm")
+            ("most-negative-short-float" "v_most_1.htm")
+            ("most-negative-single-float" "v_most_1.htm")
+            ("most-positive-double-float" "v_most_1.htm")
+            ("most-positive-fixnum" "v_most_p.htm")
+            ("most-positive-long-float" "v_most_1.htm")
+            ("most-positive-short-float" "v_most_1.htm")
+            ("most-positive-single-float" "v_most_1.htm")
+            ("muffle-warning" "a_muffle.htm")
+            ("multiple-value-bind" "m_multip.htm")
+            ("multiple-value-call" "s_multip.htm")
+            ("multiple-value-list" "m_mult_1.htm")
+            ("multiple-value-prog1" "s_mult_1.htm")
+            ("multiple-value-setq" "m_mult_2.htm")
+            ("multiple-values-limit" "v_multip.htm")
+            ("name-char" "f_name_c.htm")
+            ("namestring" "f_namest.htm")
+            ("nbutlast" "f_butlas.htm")
+            ("nconc" "f_nconc.htm")
+            ("next-method-p" "f_next_m.htm")
+            ("nil" "a_nil.htm")
+            ("nintersection" "f_isec_.htm")
+            ("ninth" "f_firstc.htm")
+            ("no-applicable-method" "f_no_app.htm")
+            ("no-next-method" "f_no_nex.htm")
+            ("not" "a_not.htm")
+            ("notany" "f_everyc.htm")
+            ("notevery" "f_everyc.htm")
+            ("notinline" "d_inline.htm")
+            ("nreconc" "f_revapp.htm")
+            ("nreverse" "f_revers.htm")
+            ("nset-difference" "f_set_di.htm")
+            ("nset-exclusive-or" "f_set_ex.htm")
+            ("nstring-capitalize" "f_stg_up.htm")
+            ("nstring-downcase" "f_stg_up.htm")
+            ("nstring-upcase" "f_stg_up.htm")
+            ("nsublis" "f_sublis.htm")
+            ("nsubst" "f_substc.htm")
+            ("nsubst-if" "f_substc.htm")
+            ("nsubst-if-not" "f_substc.htm")
+            ("nsubstitute" "f_sbs_s.htm")
+            ("nsubstitute-if" "f_sbs_s.htm")
+            ("nsubstitute-if-not" "f_sbs_s.htm")
+            ("nth" "f_nth.htm")
+            ("nth-value" "m_nth_va.htm")
+            ("nthcdr" "f_nthcdr.htm")
+            ("null" "a_null.htm")
+            ("number" "t_number.htm")
+            ("numberp" "f_nump.htm")
+            ("numerator" "f_numera.htm")
+            ("nunion" "f_unionc.htm")
+            ("oddp" "f_evenpc.htm")
+            ("open" "f_open.htm")
+            ("open-stream-p" "f_open_s.htm")
+            ("optimize" "d_optimi.htm")
+            ("or" "a_or.htm")
+            ("otherwise" "m_case_.htm")
+            ("output-stream-p" "f_in_stm.htm")
+            ("package" "t_pkg.htm")
+            ("package-error" "e_pkg_er.htm")
+            ("package-error-package" "f_pkg_er.htm")
+            ("package-name" "f_pkg_na.htm")
+            ("package-nicknames" "f_pkg_ni.htm")
+            ("package-shadowing-symbols" "f_pkg_sh.htm")
+            ("package-use-list" "f_pkg_us.htm")
+            ("package-used-by-list" "f_pkg__1.htm")
+            ("packagep" "f_pkgp.htm")
+            ("pairlis" "f_pairli.htm")
+            ("parse-error" "e_parse_.htm")
+            ("parse-integer" "f_parse_.htm")
+            ("parse-namestring" "f_pars_1.htm")
+            ("pathname" "a_pn.htm")
+            ("pathname-device" "f_pn_hos.htm")
+            ("pathname-directory" "f_pn_hos.htm")
+            ("pathname-host" "f_pn_hos.htm")
+            ("pathname-match-p" "f_pn_mat.htm")
+            ("pathname-name" "f_pn_hos.htm")
+            ("pathname-type" "f_pn_hos.htm")
+            ("pathname-version" "f_pn_hos.htm")
+            ("pathnamep" "f_pnp.htm")
+            ("peek-char" "f_peek_c.htm")
+            ("phase" "f_phase.htm")
+            ("pi" "v_pi.htm")
+            ("plusp" "f_minusp.htm")
+            ("pop" "m_pop.htm")
+            ("position" "f_pos_p.htm")
+            ("position-if" "f_pos_p.htm")
+            ("position-if-not" "f_pos_p.htm")
+            ("pprint" "f_wr_pr.htm")
+            ("pprint-dispatch" "f_ppr_di.htm")
+            ("pprint-exit-if-list-exhausted" "m_ppr_ex.htm")
+            ("pprint-fill" "f_ppr_fi.htm")
+            ("pprint-indent" "f_ppr_in.htm")
+            ("pprint-linear" "f_ppr_fi.htm")
+            ("pprint-logical-block" "m_ppr_lo.htm")
+            ("pprint-newline" "f_ppr_nl.htm")
+            ("pprint-pop" "m_ppr_po.htm")
+            ("pprint-tab" "f_ppr_ta.htm")
+            ("pprint-tabular" "f_ppr_fi.htm")
+            ("prin1" "f_wr_pr.htm")
+            ("prin1-to-string" "f_wr_to_.htm")
+            ("princ" "f_wr_pr.htm")
+            ("princ-to-string" "f_wr_to_.htm")
+            ("print" "f_wr_pr.htm")
+            ("print-not-readable" "e_pr_not.htm")
+            ("print-not-readable-object" "f_pr_not.htm")
+            ("print-object" "f_pr_obj.htm")
+            ("print-unreadable-object" "m_pr_unr.htm")
+            ("probe-file" "f_probe_.htm")
+            ("proclaim" "f_procla.htm")
+            ("prog" "m_prog_.htm")
+            ("prog*" "m_prog_.htm")
+            ("prog1" "m_prog1c.htm")
+            ("prog2" "m_prog1c.htm")
+            ("progn" "s_progn.htm")
+            ("program-error" "e_progra.htm")
+            ("progv" "s_progv.htm")
+            ("provide" "f_provid.htm")
+            ("psetf" "m_setf_.htm")
+            ("psetq" "m_psetq.htm")
+            ("push" "m_push.htm")
+            ("pushnew" "m_pshnew.htm")
+            ("quote" "s_quote.htm")
+            ("random" "f_random.htm")
+            ("random-state" "t_rnd_st.htm")
+            ("random-state-p" "f_rnd_st.htm")
+            ("rassoc" "f_rassoc.htm")
+            ("rassoc-if" "f_rassoc.htm")
+            ("rassoc-if-not" "f_rassoc.htm")
+            ("ratio" "t_ratio.htm")
+            ("rational" "a_ration.htm")
+            ("rationalize" "f_ration.htm")
+            ("rationalp" "f_rati_1.htm")
+            ("read" "f_rd_rd.htm")
+            ("read-byte" "f_rd_by.htm")
+            ("read-char" "f_rd_cha.htm")
+            ("read-char-no-hang" "f_rd_c_1.htm")
+            ("read-delimited-list" "f_rd_del.htm")
+            ("read-from-string" "f_rd_fro.htm")
+            ("read-line" "f_rd_lin.htm")
+            ("read-preserving-whitespace" "f_rd_rd.htm")
+            ("read-sequence" "f_rd_seq.htm")
+            ("reader-error" "e_rder_e.htm")
+            ("readtable" "t_rdtabl.htm")
+            ("readtable-case" "f_rdtabl.htm")
+            ("readtablep" "f_rdta_1.htm")
+            ("real" "t_real.htm")
+            ("realp" "f_realp.htm")
+            ("realpart" "f_realpa.htm")
+            ("reduce" "f_reduce.htm")
+            ("reinitialize-instance" "f_reinit.htm")
+            ("rem" "f_mod_r.htm")
+            ("remf" "m_remf.htm")
+            ("remhash" "f_remhas.htm")
+            ("remove" "f_rm_rm.htm")
+            ("remove-duplicates" "f_rm_dup.htm")
+            ("remove-if" "f_rm_rm.htm")
+            ("remove-if-not" "f_rm_rm.htm")
+            ("remove-method" "f_rm_met.htm")
+            ("remprop" "f_rempro.htm")
+            ("rename-file" "f_rn_fil.htm")
+            ("rename-package" "f_rn_pkg.htm")
+            ("replace" "f_replac.htm")
+            ("require" "f_provid.htm")
+            ("rest" "f_rest.htm")
+            ("restart" "t_rst.htm")
+            ("restart-bind" "m_rst_bi.htm")
+            ("restart-case" "m_rst_ca.htm")
+            ("restart-name" "f_rst_na.htm")
+            ("return" "m_return.htm")
+            ("return-from" "s_ret_fr.htm")
+            ("revappend" "f_revapp.htm")
+            ("reverse" "f_revers.htm")
+            ("room" "f_room.htm")
+            ("rotatef" "m_rotate.htm")
+            ("round" "f_floorc.htm")
+            ("row-major-aref" "f_row_ma.htm")
+            ("rplaca" "f_rplaca.htm")
+            ("rplacd" "f_rplaca.htm")
+            ("safety" "d_optimi.htm")
+            ("satisfies" "t_satisf.htm")
+            ("sbit" "f_bt_sb.htm")
+            ("scale-float" "f_dec_fl.htm")
+            ("schar" "f_char_.htm")
+            ("search" "f_search.htm")
+            ("second" "f_firstc.htm")
+            ("sequence" "t_seq.htm")
+            ("serious-condition" "e_seriou.htm")
+            ("set" "f_set.htm")
+            ("set-difference" "f_set_di.htm")
+            ("set-dispatch-macro-character" "f_set__1.htm")
+            ("set-exclusive-or" "f_set_ex.htm")
+            ("set-macro-character" "f_set_ma.htm")
+            ("set-pprint-dispatch" "f_set_pp.htm")
+            ("set-syntax-from-char" "f_set_sy.htm")
+            ("setf" "a_setf.htm")
+            ("setq" "s_setq.htm")
+            ("seventh" "f_firstc.htm")
+            ("shadow" "f_shadow.htm")
+            ("shadowing-import" "f_shdw_i.htm")
+            ("shared-initialize" "f_shared.htm")
+            ("shiftf" "m_shiftf.htm")
+            ("short-float" "t_short_.htm")
+            ("short-float-epsilon" "v_short_.htm")
+            ("short-float-negative-epsilon" "v_short_.htm")
+            ("short-site-name" "f_short_.htm")
+            ("signal" "f_signal.htm")
+            ("signed-byte" "t_sgn_by.htm")
+            ("signum" "f_signum.htm")
+            ("simple-array" "t_smp_ar.htm")
+            ("simple-base-string" "t_smp_ba.htm")
+            ("simple-bit-vector" "t_smp_bt.htm")
+            ("simple-bit-vector-p" "f_smp_bt.htm")
+            ("simple-condition" "e_smp_cn.htm")
+            ("simple-condition-format-arguments" "f_smp_cn.htm")
+            ("simple-condition-format-control" "f_smp_cn.htm")
+            ("simple-error" "e_smp_er.htm")
+            ("simple-string" "t_smp_st.htm")
+            ("simple-string-p" "f_smp_st.htm")
+            ("simple-type-error" "e_smp_tp.htm")
+            ("simple-vector" "t_smp_ve.htm")
+            ("simple-vector-p" "f_smp_ve.htm")
+            ("simple-warning" "e_smp_wa.htm")
+            ("sin" "f_sin_c.htm")
+            ("single-float" "t_short_.htm")
+            ("single-float-epsilon" "v_short_.htm")
+            ("single-float-negative-epsilon" "v_short_.htm")
+            ("sinh" "f_sinh_.htm")
+            ("sixth" "f_firstc.htm")
+            ("sleep" "f_sleep.htm")
+            ("slot-boundp" "f_slt_bo.htm")
+            ("slot-exists-p" "f_slt_ex.htm")
+            ("slot-makunbound" "f_slt_ma.htm")
+            ("slot-missing" "f_slt_mi.htm")
+            ("slot-unbound" "f_slt_un.htm")
+            ("slot-value" "f_slt_va.htm")
+            ("software-type" "f_sw_tpc.htm")
+            ("software-version" "f_sw_tpc.htm")
+            ("some" "f_everyc.htm")
+            ("sort" "f_sort_.htm")
+            ("space" "d_optimi.htm")
+            ("special" "d_specia.htm")
+            ("special-operator-p" "f_specia.htm")
+            ("speed" "d_optimi.htm")
+            ("sqrt" "f_sqrt_.htm")
+            ("stable-sort" "f_sort_.htm")
+            ("standard" "07_ffb.htm")
+            ("standard-char" "t_std_ch.htm")
+            ("standard-char-p" "f_std_ch.htm")
+            ("standard-class" "t_std_cl.htm")
+            ("standard-generic-function" "t_std_ge.htm")
+            ("standard-method" "t_std_me.htm")
+            ("standard-object" "t_std_ob.htm")
+            ("step" "m_step.htm")
+            ("storage-condition" "e_storag.htm")
+            ("store-value" "a_store_.htm")
+            ("stream" "t_stream.htm")
+            ("stream-element-type" "f_stm_el.htm")
+            ("stream-error" "e_stm_er.htm")
+            ("stream-error-stream" "f_stm_er.htm")
+            ("stream-external-format" "f_stm_ex.htm")
+            ("streamp" "f_stmp.htm")
+            ("string" "a_string.htm")
+            ("string-capitalize" "f_stg_up.htm")
+            ("string-downcase" "f_stg_up.htm")
+            ("string-equal" "f_stgeq_.htm")
+            ("string-greaterp" "f_stgeq_.htm")
+            ("string-left-trim" "f_stg_tr.htm")
+            ("string-lessp" "f_stgeq_.htm")
+            ("string-not-equal" "f_stgeq_.htm")
+            ("string-not-greaterp" "f_stgeq_.htm")
+            ("string-not-lessp" "f_stgeq_.htm")
+            ("string-right-trim" "f_stg_tr.htm")
+            ("string-stream" "t_stg_st.htm")
+            ("string-trim" "f_stg_tr.htm")
+            ("string-upcase" "f_stg_up.htm")
+            ("string/=" "f_stgeq_.htm")
+            ("string<" "f_stgeq_.htm")
+            ("string<=" "f_stgeq_.htm")
+            ("string=" "f_stgeq_.htm")
+            ("string>" "f_stgeq_.htm")
+            ("string>=" "f_stgeq_.htm")
+            ("stringp" "f_stgp.htm")
+            ("structure" "f_docume.htm")
+            ("structure-class" "t_stu_cl.htm")
+            ("structure-object" "t_stu_ob.htm")
+            ("style-warning" "e_style_.htm")
+            ("sublis" "f_sublis.htm")
+            ("subseq" "f_subseq.htm")
+            ("subsetp" "f_subset.htm")
+            ("subst" "f_substc.htm")
+            ("subst-if" "f_substc.htm")
+            ("subst-if-not" "f_substc.htm")
+            ("substitute" "f_sbs_s.htm")
+            ("substitute-if" "f_sbs_s.htm")
+            ("substitute-if-not" "f_sbs_s.htm")
+            ("subtypep" "f_subtpp.htm")
+            ("svref" "f_svref.htm")
+            ("sxhash" "f_sxhash.htm")
+            ("symbol" "t_symbol.htm")
+            ("symbol-function" "f_symb_1.htm")
+            ("symbol-macrolet" "s_symbol.htm")
+            ("symbol-name" "f_symb_2.htm")
+            ("symbol-package" "f_symb_3.htm")
+            ("symbol-plist" "f_symb_4.htm")
+            ("symbol-value" "f_symb_5.htm")
+            ("symbolp" "f_symbol.htm")
+            ("synonym-stream" "t_syn_st.htm")
+            ("synonym-stream-symbol" "f_syn_st.htm")
+            ("t" "a_t.htm")
+            ("tagbody" "s_tagbod.htm")
+            ("tailp" "f_ldiffc.htm")
+            ("tan" "f_sin_c.htm")
+            ("tanh" "f_sinh_.htm")
+            ("tenth" "f_firstc.htm")
+            ("terpri" "f_terpri.htm")
+            ("the" "s_the.htm")
+            ("third" "f_firstc.htm")
+            ("throw" "s_throw.htm")
+            ("time" "m_time.htm")
+            ("trace" "m_tracec.htm")
+            ("translate-logical-pathname" "f_tr_log.htm")
+            ("translate-pathname" "f_tr_pn.htm")
+            ("tree-equal" "f_tree_e.htm")
+            ("truename" "f_tn.htm")
+            ("truncate" "f_floorc.htm")
+            ("two-way-stream" "t_two_wa.htm")
+            ("two-way-stream-input-stream" "f_two_wa.htm")
+            ("two-way-stream-output-stream" "f_two_wa.htm")
+            ("type" "a_type.htm")
+            ("type-error" "e_tp_err.htm")
+            ("type-error-datum" "f_tp_err.htm")
+            ("type-error-expected-type" "f_tp_err.htm")
+            ("type-of" "f_tp_of.htm")
+            ("typecase" "m_tpcase.htm")
+            ("typep" "f_typep.htm")
+            ("unbound-slot" "e_unboun.htm")
+            ("unbound-slot-instance" "f_unboun.htm")
+            ("unbound-variable" "e_unbo_1.htm")
+            ("undefined-function" "e_undefi.htm")
+            ("unexport" "f_unexpo.htm")
+            ("unintern" "f_uninte.htm")
+            ("union" "f_unionc.htm")
+            ("unless" "m_when_.htm")
+            ("unread-char" "f_unrd_c.htm")
+            ("unsigned-byte" "t_unsgn_.htm")
+            ("untrace" "m_tracec.htm")
+            ("unuse-package" "f_unuse_.htm")
+            ("unwind-protect" "s_unwind.htm")
+            ("update-instance-for-different-class" "f_update.htm")
+            ("update-instance-for-redefined-class" "f_upda_1.htm")
+            ("upgraded-array-element-type" "f_upgr_1.htm")
+            ("upgraded-complex-part-type" "f_upgrad.htm")
+            ("upper-case-p" "f_upper_.htm")
+            ("use-package" "f_use_pk.htm")
+            ("use-value" "a_use_va.htm")
+            ("user-homedir-pathname" "f_user_h.htm")
+            ("values" "a_values.htm")
+            ("values-list" "f_vals_l.htm")
+            ("variable" "f_docume.htm")
+            ("vector" "a_vector.htm")
+            ("vector-pop" "f_vec_po.htm")
+            ("vector-push" "f_vec_ps.htm")
+            ("vector-push-extend" "f_vec_ps.htm")
+            ("vectorp" "f_vecp.htm")
+            ("warn" "f_warn.htm")
+            ("warning" "e_warnin.htm")
+            ("when" "m_when_.htm")
+            ("wild-pathname-p" "f_wild_p.htm")
+            ("with-accessors" "m_w_acce.htm")
+            ("with-compilation-unit" "m_w_comp.htm")
+            ("with-condition-restarts" "m_w_cnd_.htm")
+            ("with-hash-table-iterator" "m_w_hash.htm")
+            ("with-input-from-string" "m_w_in_f.htm")
+            ("with-open-file" "m_w_open.htm")
+            ("with-open-stream" "m_w_op_1.htm")
+            ("with-output-to-string" "m_w_out_.htm")
+            ("with-package-iterator" "m_w_pkg_.htm")
+            ("with-simple-restart" "m_w_smp_.htm")
+            ("with-slots" "m_w_slts.htm")
+            ("with-standard-io-syntax" "m_w_std_.htm")
+            ("write" "f_wr_pr.htm")
+            ("write-byte" "f_wr_by.htm")
+            ("write-char" "f_wr_cha.htm")
+            ("write-line" "f_wr_stg.htm")
+            ("write-sequence" "f_wr_seq.htm")
+            ("write-string" "f_wr_stg.htm")
+            ("write-to-string" "f_wr_to_.htm")
+            ("y-or-n-p" "f_y_or_n.htm")
+            ("yes-or-no-p" "f_y_or_n.htm")
+            ("zerop" "f_zerop.htm"))))
+                
+;;; FORMAT character lookup by Frode Vatvedt Fjeld <frodef at acm.org> 20030902
+;;;
+;;; adjusted for ILISP by Nikodemus Siivola 20030903
+
+(defvar common-lisp-hyperspec-format-history nil
+  "History of format characters looked up in the Common Lisp HyperSpec.")
+
+(defvar common-lisp-hyperspec-format-characters (make-vector 67 0))
+
+
+(defun common-lisp-hyperspec-section-6.0 (indices)
+  (let ((string (format "%sBody/%s_" 
+			common-lisp-hyperspec-root
+			(let ((base (pop indices)))
+			  (if (< base 10)
+			      (format "0%s" base)
+			    base)))))
+    (concat string 
+	    (mapconcat (lambda (n)
+			 (make-string 1 (+ ?a (- n 1))))
+		       indices
+		       "")
+	    ".htm")))
+
+(defun common-lisp-hyperspec-section-4.0 (indices)
+  (let ((string (format "%sBody/sec_"
+ 			common-lisp-hyperspec-root)))			
+    (concat string
+	    (mapconcat (lambda (n)
+			 (format "%d" n))
+		       indices
+		       "-")	    
+	    ".html")))
+
+(defvar common-lisp-hyperspec-section-fun 'common-lisp-hyperspec-section-6.0)
+
+(defun common-lisp-hyperspec-section (indices)
+  (funcall common-lisp-hyperspec-section-fun indices))
+
+(defun common-lisp-hyperspec-format (character-name)
+   (interactive 
+    (list (let ((char-at-point
+                 (ignore-errors (char-to-string (char-after (point))))))
+	    (if (and char-at-point
+		     (intern-soft (upcase char-at-point)
+				  common-lisp-hyperspec-format-characters))
+ 	       char-at-point
+ 	       (completing-read
+ 		"Look up format control character in Common Lisp HyperSpec: "
+ 		common-lisp-hyperspec-format-characters nil #'boundp
+ 		nil nil 'common-lisp-hyperspec-format-history)))))
+   (maplist (lambda (entry)
+	      (browse-url (common-lisp-hyperspec-section (car entry))))
+	    (let ((symbol (intern-soft character-name
+				       common-lisp-hyperspec-format-characters)))
+	      (if (and symbol (boundp symbol))
+		  (symbol-value symbol)
+		  (error "The symbol `%s' is not defined in Common Lisp"
+			 character-name)))))
+
+(eval-when (load eval)
+  (defalias 'hyperspec-lookup-format 'common-lisp-hyperspec-format))
+
+(mapcar (lambda (entry)
+	  (let ((symbol (intern (car entry)
+				common-lisp-hyperspec-format-characters)))
+	    (if (boundp symbol)
+		(pushnew (cadr entry) (symbol-value symbol) :test 'equal)
+		(set symbol (cdr entry))))
+	  (when (and (= 1 (length (car entry)))
+		     (not (string-equal (car entry) (upcase (car entry)))))
+	    (let ((symbol (intern (upcase (car entry)) 
+				  common-lisp-hyperspec-format-characters)))
+	      (if (boundp symbol)
+		  (pushnew (cadr entry) (symbol-value symbol) :test 'equal)
+		  (set symbol (cdr entry))))))
+	'(("c" (22 3 1 1)) ("C: Character" (22 3 1 1))
+	  ("%" (22 3 1 2)) ("Percent: Newline" (22 3 1 2))
+	  ("&" (22 3 1 3)) ("Ampersand: Fresh-line" (22 3 1 3))
+	  ("|" (22 3 1 4)) ("Vertical-Bar: Page" (22 3 1 4))
+	  ("~" (22 3 1 5)) ("Tilde: Tilde" (22 3 1 5))
+	  ("r" (22 3 2 1)) ("R: Radix" (22 3 2 1))
+	  ("d" (22 3 2 2)) ("D: Decimal" (22 3 2-2))
+          ("b" (22 3 2 3)) ("B: Binary" (22 3 2 3))
+          ("o" (22 3 2 4)) ("O: Octal" (22 3 2 4))
+          ("x" (22 3 2 5)) ("X: Hexadecimal" (22 3 2 5))
+          ("f" (22 3 3 1)) ("F: Fixed-Format Floating-Point" (22 3 3 1))
+          ("e" (22 3 3 2)) ("E: Exponential Floating-Point" (22 3 3 2))
+          ("g" (22 3 3 3)) ("G: General Floating-Point" (22 3 3 3))
+          ("$" (22 3 3 4)) ("Dollarsign: Monetary Floating-Point" (22 3 3 4))
+          ("a" (22 3 4 1)) ("A: Aesthetic" (22 3 4 1))
+          ("s" (22 3 4 2)) ("S: Standard" (22 3 4 2))
+          ("w" (22 3 4 3)) ("W: Write" (22 3 4 3))
+          ("_" (22 3 5 1)) ("Underscore: Conditional Newline" (22 3 5 1))
+          ("<" (22 3 5 2)) ("Less-Than-Sign: Logical Block" (22 3 5 2))
+          ("i" (22 3 5 3)) ("I: Indent" (22 3 5 3))
+          ("/" (22 3 5 4)) ("Slash: Call Function" (22 3 5 4))
+          ("t" (22 3 6 1)) ("T: Tabulate" (22 3 6 1))
+          ("<" (22 3 6 2)) ("Less-Than-Sign: Justification" (22 3 6 2))
+          (">" (22 3 6 3)) ("Greater-Than-Sign: End of Justification" (22 3 6 3))
+          ("*" (22 3 7 1)) ("Asterisk: Go-To" (22 3 7 1))
+          ("[" (22 3 7 2)) ("Left-Bracket: Conditional Expression" (22 3 7 2))
+          ("]" (22 3 7 3)) ("Right-Bracket: End of Conditional Expression" (22 3 7 3))
+          ("{" (22 3 7 4)) ("Left-Brace: Iteration" (22 3 7 4))
+          ("}" (22 3 7 5)) ("Right-Brace: End of Iteration" (22 3 7 5))
+          ("?" (22 3 7 6)) ("Question-Mark: Recursive Processing" (22 3 7 6))
+          ("(" (22 3 8 1)) ("Left-Paren: Case Conversion" (22 3 8 1))
+          (")" (22 3 8 2)) ("Right-Paren: End of Case Conversion" (22 3 8 2))
+          ("p" (22 3 8 3)) ("P: Plural" (22 3 8-3))
+          (";" (22 3 9 1)) ("Semicolon: Clause Separator" (22 3 9 1))
+          ("^" (22 3 9 2)) ("Circumflex: Escape Upward" (22 3 9 2))
+          ("Newline: Ignored Newline" (22 3 9 3))
+          ("Nesting of FORMAT Operations" (22 3 10 1))
+          ("Missing and Additional FORMAT Arguments" (22 3 10 2))
+          ("Additional FORMAT Parameters" (22 3 10 3))))
+
+(defvar common-lisp-glossary-fun 'common-lisp-glossary-6.0)
+
+(defun common-lisp-glossary-6.0 (string)
+  (format "%sBody/26_glo_%s.htm#%s"
+	  common-lisp-hyperspec-root
+	  (let ((char (string-to-char string)))
+	    (if (and (<= ?a char)
+		     (<= char ?z))
+		(make-string 1 char)
+	      "9"))
+	  (subst-char-in-string ?\  ?_ string)))
+
+(defun common-lisp-glossary-4.0 (string)
+  (format "%sBody/glo_%s.html#%s"
+	  common-lisp-hyperspec-root
+	  (let ((char (string-to-char string)))
+	    (if (and (<= ?a char)
+		     (<= char ?z))
+		(make-string 1 char)
+	      "9"))
+	  (subst-char-in-string ?\  ?_ string)))
+
+(defvar common-lisp-hyperspec-issuex-table nil
+  "The HyperSpec IssueX table file.  If you copy the HyperSpec to your
+local system, set this variable to the location of the Issue
+cross-references table which is usually \"Map_IssX.txt\" or
+\"Issue-Cross-Refs.text\".")
+
+(defvar common-lisp-hyperspec-issuex-symbols (make-vector 67 0))
+
+(if common-lisp-hyperspec-issuex-table
+    (let ((index-buffer (find-file-noselect common-lisp-hyperspec-issuex-table)))
+      (labels ((get-one-line ()
+			     (prog1 
+				 (delete* ?\n (thing-at-point 'line))
+			       (forward-line))))
+        (save-excursion
+          (set-buffer index-buffer)
+          (goto-char (point-min))
+          (while (< (point) (point-max))
+            (let* ((symbol (intern (downcase (get-one-line))
+                                   common-lisp-hyperspec-issuex-symbols))
+                   (relative-url (get-one-line)))
+              (set symbol (subseq relative-url
+				  (1+ (position ?\/ relative-url :from-end t)))))))))
+  (mapcar 
+   (lambda (entry)
+     (let ((symbol (intern (car entry) common-lisp-hyperspec-issuex-symbols)))
+       (set symbol (cadr entry))))
+   '(("&environment-binding-order:first" "iss001.htm")
+     ("access-error-name" "iss002.htm") 
+     ("adjust-array-displacement" "iss003.htm") 
+     ("adjust-array-fill-pointer" "iss004.htm")
+     ("adjust-array-not-adjustable:implicit-copy" "iss005.htm")
+     ("allocate-instance:add" "iss006.htm")
+     ("allow-local-inline:inline-notinline" "iss007.htm")
+     ("allow-other-keys-nil:permit" "iss008.htm") 
+     ("aref-1d" "iss009.htm")
+     ("argument-mismatch-error-again:consistent" "iss010.htm")
+     ("argument-mismatch-error-moon:fix" "iss011.htm")
+     ("argument-mismatch-error:more-clarifications" "iss012.htm")
+     ("arguments-underspecified:specify" "iss013.htm")
+     ("array-dimension-limit-implications:all-fixnum" "iss014.htm")
+     ("array-type-element-type-semantics:unify-upgrading" "iss015.htm")
+     ("assert-error-type:error" "iss016.htm") 
+     ("assoc-rassoc-if-key" "iss017.htm") 
+     ("assoc-rassoc-if-key:yes" "iss018.htm")
+     ("boa-aux-initialization:error-on-read" "iss019.htm")
+     ("break-on-warnings-obsolete:remove" "iss020.htm")
+     ("broadcast-stream-return-values:clarify-minimally" "iss021.htm")
+     ("butlast-negative:should-signal" "iss022.htm")
+     ("change-class-initargs:permit" "iss023.htm")
+     ("char-name-case:x3j13-mar-91" "iss024.htm")
+     ("character-loose-ends:fix" "iss025.htm") 
+     ("character-proposal:2" "iss026.htm") 
+     ("character-proposal:2-1-1" "iss027.htm")
+     ("character-proposal:2-1-2" "iss028.htm") 
+     ("character-proposal:2-2-1" "iss029.htm") 
+     ("character-proposal:2-3-1" "iss030.htm")
+     ("character-proposal:2-3-2" "iss031.htm") 
+     ("character-proposal:2-3-3" "iss032.htm")
+     ("character-proposal:2-3-4" "iss033.htm")
+     ("character-proposal:2-3-5" "iss034.htm")
+     ("character-proposal:2-3-6" "iss035.htm") 
+     ("character-proposal:2-4-1" "iss036.htm")
+     ("character-proposal:2-4-2" "iss037.htm") 
+     ("character-proposal:2-4-3" "iss038.htm") 
+     ("character-proposal:2-5-2" "iss039.htm")
+     ("character-proposal:2-5-6" "iss040.htm") 
+     ("character-proposal:2-5-7" "iss041.htm") 
+     ("character-proposal:2-6-1" "iss042.htm")
+     ("character-proposal:2-6-2" "iss043.htm") 
+     ("character-proposal:2-6-3" "iss044.htm") 
+     ("character-proposal:2-6-5" "iss045.htm")
+     ("character-vs-char:less-inconsistent-short" "iss046.htm")
+     ("class-object-specializer:affirm" "iss047.htm")
+     ("clos-conditions-again:allow-subset" "iss048.htm")
+     ("clos-conditions:integrate" "iss049.htm")
+     ("clos-error-checking-order:no-applicable-method-first" "iss050.htm")
+     ("clos-macro-compilation:minimal" "iss051.htm")
+     ("close-constructed-stream:argument-stream-only" "iss052.htm")
+     ("closed-stream-operations:allow-inquiry" "iss053.htm")
+     ("coercing-setf-name-to-function:all-function-names" "iss054.htm")
+     ("colon-number" "iss055.htm") 
+     ("common-features:specify" "iss056.htm")
+     ("common-type:remove" "iss057.htm")
+     ("compile-argument-problems-again:fix" "iss058.htm")
+     ("compile-file-handling-of-top-level-forms:clarify" "iss059.htm")
+     ("compile-file-output-file-defaults:input-file" "iss060.htm")
+     ("compile-file-package" "iss061.htm")
+     ("compile-file-pathname-arguments:make-consistent" "iss062.htm")
+     ("compile-file-symbol-handling:new-require-consistency" "iss063.htm")
+     ("compiled-function-requirements:tighten" "iss064.htm")
+     ("compiler-diagnostics:use-handler" "iss065.htm")
+     ("compiler-let-confusion:eliminate" "iss066.htm")
+     ("compiler-verbosity:like-load" "iss067.htm")
+     ("compiler-warning-stream" "iss068.htm")
+     ("complex-atan-branch-cut:tweak" "iss069.htm")
+     ("complex-atanh-bogus-formula:tweak-more" "iss070.htm")
+     ("complex-rational-result:extend" "iss071.htm")
+     ("compute-applicable-methods:generic" "iss072.htm")
+     ("concatenate-sequence:signal-error" "iss073.htm")
+     ("condition-accessors-setfable:no" "iss074.htm")
+     ("condition-restarts:buggy" "iss075.htm")
+     ("condition-restarts:permit-association" "iss076.htm")
+     ("condition-slots:hidden" "iss077.htm") 
+     ("cons-type-specifier:add" "iss078.htm") 
+     ("constant-circular-compilation:yes" "iss079.htm")
+     ("constant-collapsing:generalize" "iss080.htm")
+     ("constant-compilable-types:specify" "iss081.htm")
+     ("constant-function-compilation:no" "iss082.htm")
+     ("constant-modification:disallow" "iss083.htm")
+     ("constantp-definition:intentional" "iss084.htm")
+     ("constantp-environment:add-arg" "iss085.htm")
+     ("contagion-on-numerical-comparisons:transitive" "iss086.htm")
+     ("copy-symbol-copy-plist:copy-list" "iss087.htm")
+     ("copy-symbol-print-name:equal" "iss088.htm")
+     ("data-io:add-support" "iss089.htm")
+     ("data-types-hierarchy-underspecified" "iss090.htm")
+     ("debugger-hook-vs-break:clarify" "iss091.htm")
+     ("declaration-scope:no-hoisting" "iss092.htm")
+     ("declare-array-type-element-references:restrictive" "iss093.htm")
+     ("declare-function-ambiguity:delete-ftype-abbreviation" "iss094.htm")
+     ("declare-macros:flush" "iss095.htm")
+     ("declare-type-free:lexical" "iss096.htm")
+     ("decls-and-doc" "iss097.htm")
+     ("decode-universal-time-daylight:like-encode" "iss098.htm")
+     ("defconstant-special:no" "iss099.htm")
+     ("defgeneric-declare:allow-multiple" "iss100.htm")
+     ("define-compiler-macro:x3j13-nov89" "iss101.htm")
+     ("define-condition-syntax:incompatibly-more-like-defclass+emphasize-read-only" "iss102.htm")
+     ("define-method-combination-behavior:clarify" "iss103.htm")
+     ("defining-macros-non-top-level:allow" "iss104.htm")
+     ("defmacro-block-scope:excludes-bindings" "iss105.htm")
+     ("defmacro-lambda-list:tighten-description" "iss106.htm")
+     ("defmethod-declaration-scope:corresponds-to-bindings" "iss107.htm")
+     ("defpackage:addition" "iss108.htm")
+     ("defstruct-constructor-key-mixture:allow-key" "iss109.htm")
+     ("defstruct-constructor-options:explicit" "iss110.htm")
+     ("defstruct-constructor-slot-variables:not-bound" "iss111.htm")
+     ("defstruct-copier-argument-type:restrict" "iss112.htm")
+     ("defstruct-copier:argument-type" "iss113.htm")
+     ("defstruct-default-value-evaluation:iff-needed" "iss114.htm")
+     ("defstruct-include-deftype:explicitly-undefined" "iss115.htm")
+     ("defstruct-print-function-again:x3j13-mar-93" "iss116.htm")
+     ("defstruct-print-function-inheritance:yes" "iss117.htm")
+     ("defstruct-redefinition:error" "iss118.htm")
+     ("defstruct-slots-constraints-name:duplicates-error" "iss119.htm")
+     ("defstruct-slots-constraints-number" "iss120.htm")
+     ("deftype-destructuring:yes" "iss121.htm")
+     ("deftype-key:allow" "iss122.htm")
+     ("defvar-documentation:unevaluated" "iss123.htm")
+     ("defvar-init-time:not-delayed" "iss124.htm")
+     ("defvar-initialization:conservative" "iss125.htm")
+     ("deprecation-position:limited" "iss126.htm")
+     ("describe-interactive:no" "iss127.htm")
+     ("describe-underspecified:describe-object" "iss128.htm")
+     ("destructive-operations:specify" "iss129.htm")
+     ("destructuring-bind:new-macro" "iss130.htm")
+     ("disassemble-side-effect:do-not-install" "iss131.htm")
+     ("displaced-array-predicate:add" "iss132.htm")
+     ("do-symbols-block-scope:entire-form" "iss133.htm")
+     ("do-symbols-duplicates" "iss134.htm")
+     ("documentation-function-bugs:fix" "iss135.htm")
+     ("documentation-function-tangled:require-argument" "iss136.htm")
+     ("dotimes-ignore:x3j13-mar91" "iss137.htm")
+     ("dotted-list-arguments:clarify" "iss138.htm")
+     ("dotted-macro-forms:allow" "iss139.htm")
+     ("dribble-technique" "iss140.htm") 
+     ("dynamic-extent-function:extend" "iss141.htm")
+     ("dynamic-extent:new-declaration" "iss142.htm")
+     ("equal-structure:maybe-status-quo" "iss143.htm")
+     ("error-terminology-warning:might" "iss144.htm")
+     ("eval-other:self-evaluate" "iss145.htm")
+     ("eval-top-level:load-like-compile-file" "iss146.htm")
+     ("eval-when-non-top-level:generalize-eval-new-keywords" "iss147.htm")
+     ("eval-when-obsolete-keywords:x3j13-mar-1993" "iss148.htm")
+     ("evalhook-step-confusion:fix" "iss149.htm")
+     ("evalhook-step-confusion:x3j13-nov-89" "iss150.htm")
+     ("exit-extent-and-condition-system:like-dynamic-bindings" "iss151.htm")
+     ("exit-extent:minimal" "iss152.htm")
+     ("expt-ratio:p.211" "iss153.htm")
+     ("extensions-position:documentation" "iss154.htm")
+     ("external-format-for-every-file-connection:minimum" "iss155.htm")
+     ("extra-return-values:no" "iss156.htm")
+     ("file-open-error:signal-file-error" "iss157.htm")
+     ("fixnum-non-portable:tighten-definition" "iss158.htm")
+     ("flet-declarations" "iss159.htm")
+     ("flet-declarations:allow" "iss160.htm")
+     ("flet-implicit-block:yes" "iss161.htm")
+     ("float-underflow:add-variables" "iss162.htm")
+     ("floating-point-condition-names:x3j13-nov-89" "iss163.htm")
+     ("format-atsign-colon" "iss164.htm")
+     ("format-colon-uparrow-scope" "iss165.htm")
+     ("format-comma-interval" "iss166.htm")
+     ("format-e-exponent-sign:force-sign" "iss167.htm")
+     ("format-op-c" "iss168.htm")
+     ("format-pretty-print:yes" "iss169.htm")
+     ("format-string-arguments:specify" "iss170.htm")
+     ("function-call-evaluation-order:more-unspecified" "iss171.htm")
+     ("function-composition:jan89-x3j13" "iss172.htm")
+     ("function-definition:jan89-x3j13" "iss173.htm")
+     ("function-name:large" "iss174.htm")
+     ("function-type" "iss175.htm")
+     ("function-type-argument-type-semantics:restrictive" "iss176.htm")
+     ("function-type-key-name:specify-keyword" "iss177.htm")
+     ("function-type-rest-list-element:use-actual-argument-type" "iss178.htm")
+     ("function-type:x3j13-march-88" "iss179.htm")
+     ("generalize-pretty-printer:unify" "iss180.htm")
+     ("generic-flet-poorly-designed:delete" "iss181.htm")
+     ("gensym-name-stickiness:like-teflon" "iss182.htm")
+     ("gentemp-bad-idea:deprecate" "iss183.htm")
+     ("get-macro-character-readtable:nil-standard" "iss184.htm")
+     ("get-setf-method-environment:add-arg" "iss185.htm")
+     ("hash-table-access:x3j13-mar-89" "iss186.htm")
+     ("hash-table-key-modification:specify" "iss187.htm")
+     ("hash-table-package-generators:add-with-wrapper" "iss188.htm")
+     ("hash-table-rehash-size-integer" "iss189.htm")
+     ("hash-table-size:intended-entries" "iss190.htm")
+     ("hash-table-tests:add-equalp" "iss191.htm")
+     ("ieee-atan-branch-cut:split" "iss192.htm")
+     ("ignore-use-terminology:value-only" "iss193.htm")
+     ("import-setf-symbol-package" "iss194.htm")
+     ("in-package-functionality:mar89-x3j13" "iss195.htm")
+     ("in-syntax:minimal" "iss196.htm")
+     ("initialization-function-keyword-checking" "iss197.htm")
+     ("iso-compatibility:add-substrate" "iss198.htm")
+     ("jun90-trivial-issues:11" "iss199.htm")
+     ("jun90-trivial-issues:14" "iss200.htm")
+     ("jun90-trivial-issues:24" "iss201.htm")
+     ("jun90-trivial-issues:25" "iss202.htm")
+     ("jun90-trivial-issues:27" "iss203.htm")
+     ("jun90-trivial-issues:3" "iss204.htm")
+     ("jun90-trivial-issues:4" "iss205.htm")
+     ("jun90-trivial-issues:5" "iss206.htm")
+     ("jun90-trivial-issues:9" "iss207.htm")
+     ("keyword-argument-name-package:any" "iss208.htm")
+     ("last-n" "iss209.htm")
+     ("lcm-no-arguments:1" "iss210.htm")
+     ("lexical-construct-global-definition:undefined" "iss211.htm")
+     ("lisp-package-name:common-lisp" "iss212.htm")
+     ("lisp-symbol-redefinition-again:more-fixes" "iss213.htm")
+     ("lisp-symbol-redefinition:mar89-x3j13" "iss214.htm")
+     ("load-objects:make-load-form" "iss215.htm")
+     ("load-time-eval:r**2-new-special-form" "iss216.htm")
+     ("load-time-eval:r**3-new-special-form" "iss217.htm")
+     ("load-truename:new-pathname-variables" "iss218.htm")
+     ("locally-top-level:special-form" "iss219.htm")
+     ("loop-and-discrepancy:no-reiteration" "iss220.htm")
+     ("loop-for-as-on-typo:fix-typo" "iss221.htm")
+     ("loop-initform-environment:partial-interleaving-vague" "iss222.htm")
+     ("loop-miscellaneous-repairs:fix" "iss223.htm")
+     ("loop-named-block-nil:override" "iss224.htm")
+     ("loop-present-symbols-typo:flush-wrong-words" "iss225.htm")
+     ("loop-syntax-overhaul:repair" "iss226.htm")
+     ("macro-as-function:disallow" "iss227.htm")
+     ("macro-declarations:make-explicit" "iss228.htm")
+     ("macro-environment-extent:dynamic" "iss229.htm")
+     ("macro-function-environment" "iss230.htm")
+     ("macro-function-environment:yes" "iss231.htm")
+     ("macro-subforms-top-level-p:add-constraints" "iss232.htm")
+     ("macroexpand-hook-default:explicitly-vague" "iss233.htm")
+     ("macroexpand-hook-initial-value:implementation-dependent" "iss234.htm")
+     ("macroexpand-return-value:true" "iss235.htm")
+     ("make-load-form-confusion:rewrite" "iss236.htm")
+     ("make-load-form-saving-slots:no-initforms" "iss237.htm")
+     ("make-package-use-default:implementation-dependent" "iss238.htm")
+     ("map-into:add-function" "iss239.htm")
+     ("mapping-destructive-interaction:explicitly-vague" "iss240.htm")
+     ("metaclass-of-system-class:unspecified" "iss241.htm")
+     ("method-combination-arguments:clarify" "iss242.htm")
+     ("method-initform:forbid-call-next-method" "iss243.htm")
+     ("muffle-warning-condition-argument" "iss244.htm")
+     ("multiple-value-setq-order:like-setf-of-values" "iss245.htm")
+     ("multiple-values-limit-on-variables:undefined" "iss246.htm")
+     ("nintersection-destruction" "iss247.htm")
+     ("nintersection-destruction:revert" "iss248.htm")
+     ("not-and-null-return-value:x3j13-mar-93" "iss249.htm")
+     ("nth-value:add" "iss250.htm")
+     ("optimize-debug-info:new-quality" "iss251.htm")
+     ("package-clutter:reduce" "iss252.htm")
+     ("package-deletion:new-function" "iss253.htm")
+     ("package-function-consistency:more-permissive" "iss254.htm")
+     ("parse-error-stream:split-types" "iss255.htm")
+     ("pathname-component-case:keyword-argument" "iss256.htm")
+     ("pathname-component-value:specify" "iss257.htm")
+     ("pathname-host-parsing:recognize-logical-host-names" "iss258.htm")
+     ("pathname-logical:add" "iss259.htm")
+     ("pathname-print-read:sharpsign-p" "iss260.htm")
+     ("pathname-stream" "iss261.htm")
+     ("pathname-stream:files-or-synonym" "iss262.htm")
+     ("pathname-subdirectory-list:new-representation" "iss263.htm")
+     ("pathname-symbol" "iss264.htm")
+     ("pathname-syntax-error-time:explicitly-vague" "iss265.htm")
+     ("pathname-unspecific-component:new-token" "iss266.htm")
+     ("pathname-wild:new-functions" "iss267.htm")
+     ("peek-char-read-char-echo:first-read-char" "iss268.htm")
+     ("plist-duplicates:allow" "iss269.htm")
+     ("pretty-print-interface" "iss270.htm")
+     ("princ-readably:x3j13-dec-91" "iss271.htm")
+     ("print-case-behavior:clarify" "iss272.htm")
+     ("print-case-print-escape-interaction:vertical-bar-rule-no-upcase" "iss273.htm") 
+     ("print-circle-shared:respect-print-circle" "iss274.htm")
+     ("print-circle-structure:user-functions-work" "iss275.htm") 
+     ("print-readably-behavior:clarify" "iss276.htm")
+     ("printer-whitespace:just-one-space" "iss277.htm")
+     ("proclaim-etc-in-compile-file:new-macro" "iss278.htm")
+     ("push-evaluation-order:first-item" "iss279.htm")
+     ("push-evaluation-order:item-first" "iss280.htm")
+     ("pushnew-store-required:unspecified" "iss281.htm")
+     ("quote-semantics:no-copying" "iss282.htm")
+     ("range-of-count-keyword:nil-or-integer" "iss283.htm")
+     ("range-of-start-and-end-parameters:integer-and-integer-nil" "iss284.htm")
+     ("read-and-write-bytes:new-functions" "iss285.htm")
+     ("read-case-sensitivity:readtable-keywords" "iss286.htm")
+     ("read-modify-write-evaluation-order:delayed-access-stores" "iss287.htm")
+     ("read-suppress-confusing:generalize" "iss288.htm")
+     ("reader-error:new-type" "iss289.htm")
+     ("real-number-type:x3j13-mar-89" "iss290.htm")
+     ("recursive-deftype:explicitly-vague" "iss291.htm")
+     ("reduce-argument-extraction" "iss292.htm")
+     ("remf-destruction-unspecified:x3j13-mar-89" "iss293.htm")
+     ("require-pathname-defaults-again:x3j13-dec-91" "iss294.htm")
+     ("require-pathname-defaults-yet-again:restore-argument" "iss295.htm")
+     ("require-pathname-defaults:eliminate" "iss296.htm")
+     ("rest-list-allocation:may-share" "iss297.htm")
+     ("result-lists-shared:specify" "iss298.htm")
+     ("return-values-unspecified:specify" "iss299.htm")
+     ("room-default-argument:new-value" "iss300.htm")
+     ("self-modifying-code:forbid" "iss301.htm")
+     ("sequence-type-length:must-match" "iss302.htm")
+     ("setf-apply-expansion:ignore-expander" "iss303.htm")
+     ("setf-find-class:allow-nil" "iss304.htm")
+     ("setf-functions-again:minimal-changes" "iss305.htm")
+     ("setf-get-default:evaluated-but-ignored" "iss306.htm")
+     ("setf-macro-expansion:last" "iss307.htm")
+     ("setf-method-vs-setf-method:rename-old-terms" "iss308.htm")
+     ("setf-multiple-store-variables:allow" "iss309.htm")
+     ("setf-of-apply:only-aref-and-friends" "iss310.htm")
+     ("setf-of-values:add" "iss311.htm")
+     ("setf-sub-methods:delayed-access-stores" "iss312.htm")
+     ("shadow-already-present" "iss313.htm")
+     ("shadow-already-present:works" "iss314.htm")
+     ("sharp-comma-confusion:remove" "iss315.htm")
+     ("sharp-o-foobar:consequences-undefined" "iss316.htm")
+     ("sharp-star-delimiter:normal-delimiter" "iss317.htm")
+     ("sharpsign-plus-minus-package:keyword" "iss318.htm")
+     ("slot-missing-values:specify" "iss319.htm")
+     ("slot-value-metaclasses:less-minimal" "iss320.htm")
+     ("special-form-p-misnomer:rename" "iss321.htm")
+     ("special-type-shadowing:clarify" "iss322.htm")
+     ("standard-input-initial-binding:defined-contracts" "iss323.htm")
+     ("standard-repertoire-gratuitous:rename" "iss324.htm")
+     ("step-environment:current" "iss325.htm") 
+     ("step-minimal:permit-progn" "iss326.htm") 
+     ("stream-access:add-types-accessors" "iss327.htm")
+     ("stream-capabilities:interactive-stream-p" "iss328.htm")
+     ("string-coercion:make-consistent" "iss329.htm")
+     ("string-output-stream-bashing:undefined" "iss330.htm")
+     ("structure-read-print-syntax:keywords" "iss331.htm")
+     ("subseq-out-of-bounds" "iss332.htm")
+     ("subseq-out-of-bounds:is-an-error" "iss333.htm")
+     ("subsetting-position:none" "iss334.htm")
+     ("subtypep-environment:add-arg" "iss335.htm")
+     ("subtypep-too-vague:clarify-more" "iss336.htm")
+     ("sxhash-definition:similar-for-sxhash" "iss337.htm")
+     ("symbol-macrolet-declare:allow" "iss338.htm")
+     ("symbol-macrolet-semantics:special-form" "iss339.htm")
+     ("symbol-macrolet-type-declaration:no" "iss340.htm")
+     ("symbol-macros-and-proclaimed-specials:signals-an-error" "iss341.htm")
+     ("symbol-print-escape-behavior:clarify" "iss342.htm")
+     ("syntactic-environment-access:retracted-mar91" "iss343.htm")
+     ("tagbody-tag-expansion:no" "iss344.htm")
+     ("tailp-nil:t" "iss345.htm")
+     ("test-not-if-not:flush-all" "iss346.htm")
+     ("the-ambiguity:for-declaration" "iss347.htm")
+     ("the-values:return-number-received" "iss348.htm")
+     ("time-zone-non-integer:allow" "iss349.htm")
+     ("type-declaration-abbreviation:allow-all" "iss350.htm")
+     ("type-of-and-predefined-classes:type-of-handles-floats" "iss351.htm")
+     ("type-of-and-predefined-classes:unify-and-extend" "iss352.htm")
+     ("type-of-underconstrained:add-constraints" "iss353.htm")
+     ("type-specifier-abbreviation:x3j13-jun90-guess" "iss354.htm")
+     ("undefined-variables-and-functions:compromise" "iss355.htm")
+     ("uninitialized-elements:consequences-undefined" "iss356.htm")
+     ("unread-char-after-peek-char:dont-allow" "iss357.htm")
+     ("unsolicited-messages:not-to-system-user-streams" "iss358.htm")
+     ("variable-list-asymmetry:symmetrize" "iss359.htm")
+     ("with-added-methods:delete" "iss360.htm")
+     ("with-compilation-unit:new-macro" "iss361.htm")
+     ("with-open-file-does-not-exist:stream-is-nil" "iss362.htm")
+     ("with-open-file-setq:explicitly-vague" "iss363.htm")
+     ("with-open-file-stream-extent:dynamic-extent" "iss364.htm")
+     ("with-output-to-string-append-style:vector-push-extend" "iss365.htm")
+     ("with-standard-io-syntax-readtable:x3j13-mar-91" "iss366.htm"))))
+
+(defun common-lisp-issuex (issue-name)
+  (let ((symbol 
+	 (intern (downcase issue-name) common-lisp-hyperspec-issuex-symbols)))
+    (concat common-lisp-hyperspec-root "Issues/" (symbol-value symbol))))
+
+(provide 'hyperspec)
+
+;;; hyperspec.el ends here

Added: branches/trunk-reorg/thirdparty/slime/metering.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/metering.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/metering.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1222 @@
+;;; -*- Mode: LISP; Package: monitor; Syntax: Common-lisp; Base: 10.;  -*-
+;;; Tue Jan 25 18:32:28 1994 by Mark Kantrowitz <mkant at GLINDA.OZ.CS.CMU.EDU>
+
+;;; ****************************************************************
+;;; Metering System ************************************************
+;;; ****************************************************************
+;;;
+;;; The Metering System is a portable Common Lisp code profiling tool.
+;;; It gathers timing and consing statistics for specified functions
+;;; while a program is running.
+;;;
+;;; The Metering System is a combination of
+;;;   o  the Monitor package written by Chris McConnell
+;;;   o  the Profile package written by Skef Wholey and Rob MacLachlan
+;;; The two systems were merged and extended by Mark Kantrowitz.
+;;;
+;;; Address: Carnegie Mellon University
+;;;          School of Computer Science
+;;;          Pittsburgh, PA 15213
+;;;
+;;; This code is in the public domain and is distributed without warranty
+;;; of any kind.
+;;;
+;;; This copy is from SLIME, http://www.common-lisp.net/project/slime/
+;;;
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; 26-JUN-90  mk       Merged functionality of Monitor and Profile packages.
+;;; 26-JUN-90  mk       Now handles both inclusive and exclusive statistics
+;;;                     with respect to nested calls. (Allows it to subtract
+;;;                     total monitoring overhead for each function, not just
+;;;                     the time spent monitoring the function itself.)
+;;; 26-JUN-90  mk       The table is now saved so that one may manipulate
+;;;                     the data (sorting it, etc.) even after the original
+;;;                     source of the data has been cleared.
+;;; 25-SEP-90  mk       Added get-cons functions for Lucid 3.0, MACL 1.3.2
+;;;                     required-arguments functions for Lucid 3.0,
+;;;                     Franz Allegro CL, and MACL 1.3.2.
+;;; 25-JAN-91  mk       Now uses fdefinition if available.
+;;; 25-JAN-91  mk       Replaced (and :allegro (not :coral)) with :excl.
+;;;                     Much better solution for the fact that both call
+;;;                     themselves :allegro.
+;;;  5-JUL-91 mk        Fixed warning to occur only when file is loaded
+;;;                     uncompiled.
+;;;  5-JUL-91 mk        When many unmonitored functions, print out number
+;;;                     instead of whole list.
+;;; 24-MAR-92 mk        Updated for CLtL2 compatibility. space measuring
+;;;                     doesn't work in MCL, but fixed so that timing
+;;;                     statistics do.
+;;; 26-MAR-92 mk        Updated for Lispworks. Replaced :ccl with
+;;;                     (and :ccl (not :lispworks)).
+;;; 27-MAR-92 mk        Added get-cons for Allegro-V4.0.
+;;; 01-JAN-93 mk  v2.0  Support for MCL 2.0, CMU CL 16d, Allegro V3.1/4.0/4.1,
+;;;                     Lucid 4.0, ibcl
+;;; 25-JAN-94 mk  v2.1  Patches for CLISP from Bruno Haible.
+;;; 01-APR-05 lgorrie   Removed support for all Lisps except CLISP and OpenMCL.
+;;;                     Purely to cut down on stale code (e.g. #+cltl2) in this
+;;;                     version that is bundled with SLIME.
+;;;                     
+;;;
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;;    - Need get-cons for Allegro, AKCL.
+;;;    - Speed up monitoring code. Replace use of hash tables with an embedded
+;;;      offset in an array so that it will be faster than using gethash.
+;;;      (i.e., svref/closure reference is usually faster than gethash).
+;;;    - Beware of (get-internal-run-time) overflowing. Yikes!
+;;;    - Check robustness with respect to profiled functions.
+;;;    - Check logic of computing inclusive and exclusive time and consing.
+;;;      Especially wrt incf/setf comment below. Should be incf, so we
+;;;      sum recursive calls.
+;;;    - Add option to record caller statistics -- this would list who
+;;;      called which functions and how often.
+;;;    - switches to turn timing/CONSING statistics collection on/off.
+
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;;    METERING has been tested (successfully) in the following lisps:
+;;;       CMU Common Lisp (16d, Python Compiler 1.0 ) :new-compiler
+;;;       CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;;       Macintosh Allegro Common Lisp (1.3.2)
+;;;       Macintosh Common Lisp (2.0)
+;;;       ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 11/19/90)   :allegro-v3.1
+;;;       ExCL (Franz Allegro CL 4.0.1 [Sun4] 2/8/91)          :allegro-v4.0
+;;;       ExCL (Franz Allegro CL 4.1 [SPARC R1] 8/28/92 14:06) :allegro-v4.1
+;;;       ExCL (Franz ACL 5.0.1 [Linux/X86] 6/29/99 16:11)     :allegro-v5.0.1
+;;;       Lucid CL (Version 2.1 6-DEC-87)
+;;;       Lucid Common Lisp (3.0)
+;;;       Lucid Common Lisp (4.0.1 HP-700 12-Aug-91)
+;;;       AKCL (1.86, June 30, 1987 or later)
+;;;       Ibuki Common Lisp (Version 2, release 01.027)
+;;;       CLISP (January 1994)
+;;;
+;;;    METERING needs to be tested in the following lisps:
+;;;       Symbolics Common Lisp (8.0)
+;;;       KCL (June 3, 1987 or later)
+;;;       TI (Release 4.1 or later)
+;;;       Golden Common Lisp (3.1 IBM-PC)
+;;;       VAXLisp (2.0, 3.1)
+;;;       Procyon Common Lisp
+
+
+;;; ****************************************************************
+;;; Documentation **************************************************
+;;; ****************************************************************
+;;;
+;;; This system runs in any valid Common Lisp. Four small
+;;; implementation-dependent changes can be made to improve performance
+;;; and prettiness. In the section labelled "Implementation Dependent
+;;; Changes" below, you should tailor the functions REQUIRED-ARGUMENTS,
+;;; GET-CONS, GET-TIME, and TIME-UNITS-PER-SECOND to your implementation
+;;; for the best results. If GET-CONS is not specified for your
+;;; implementation, no consing information will be reported. The other
+;;; functions will default to working forms, albeit inefficient, in
+;;; non-CMU implementations. If you tailor these functions for a particular
+;;; version of Common Lisp, we'd appreciate receiving the code.
+;;;
+
+;;; ****************************************************************
+;;; Usage Notes ****************************************************
+;;; ****************************************************************
+;;;
+;;; SUGGESTED USAGE:
+;;;
+;;; Start by monitoring big pieces of the program, then carefully choose
+;;; which functions close to, but not in, the inner loop are to be
+;;; monitored next. Don't monitor functions that are called by other
+;;; monitored functions: you will only confuse yourself.
+;;;
+;;; If the per-call time reported is less than 1/10th of a second, then
+;;; consider the clock resolution and profiling overhead before you believe
+;;; the time. It may be that you will need to run your program many times
+;;; in order to average out to a higher resolution.
+;;;
+;;; The easiest way to use this package is to load it and execute either
+;;;     (mon:with-monitoring (names*) ()
+;;;         your-forms*)
+;;; or
+;;;     (mon:monitor-form your-form)
+;;; The former allows you to specify which functions will be monitored; the
+;;; latter monitors all functions in the current package. Both automatically
+;;; produce a table of statistics. Other variants can be constructed from
+;;; the monitoring primitives, which are described below, along with a
+;;; fuller description of these two macros.
+;;;
+;;; For best results, compile this file before using.
+;;;
+;;;
+;;; CLOCK RESOLUTION:
+;;;
+;;; Unless you are very lucky, the length of your machine's clock "tick" is
+;;; probably much longer than the time it takes a simple function to run.
+;;; For example, on the IBM RT, the clock resolution is 1/50th of a second.
+;;; This means that if a function is only called a few times, then only the
+;;; first couple of decimal places are really meaningful.
+;;;
+;;;
+;;; MONITORING OVERHEAD:
+;;;
+;;; The added monitoring code takes time to run every time that the monitored
+;;; function is called, which can disrupt the attempt to collect timing
+;;; information. In order to avoid serious inflation of the times for functions
+;;; that take little time to run, an estimate of the overhead due to monitoring
+;;; is subtracted from the times reported for each function.
+;;;
+;;; Although this correction works fairly well, it is not totally accurate,
+;;; resulting in times that become increasingly meaningless for functions
+;;; with short runtimes. For example, subtracting the estimated overhead
+;;; may result in negative times for some functions. This is only a concern
+;;; when the estimated profiling overhead is many times larger than
+;;; reported total CPU time.
+;;;
+;;; If you monitor functions that are called by monitored functions, in
+;;; :inclusive mode the monitoring overhead for the inner function is
+;;; subtracted from the CPU time for the outer function. [We do this by
+;;; counting for each function not only the number of calls to *this*
+;;; function, but also the number of monitored calls while it was running.]
+;;; In :exclusive mode this is not necessary, since we subtract the
+;;; monitoring time of inner functions, overhead & all.
+;;;
+;;; Otherwise, the estimated monitoring overhead is not represented in the
+;;; reported total CPU time. The sum of total CPU time and the estimated
+;;; monitoring overhead should be close to the total CPU time for the
+;;; entire monitoring run (as determined by TIME).
+;;;
+;;; A timing overhead factor is computed at load time. This will be incorrect
+;;; if the monitoring code is run in a different environment than this file
+;;; was loaded in. For example, saving a core image on a high performance
+;;; machine and running it on a low performance one will result in the use
+;;; of an erroneously small overhead factor.
+;;;
+;;;
+;;; If your times vary widely, possible causes are:
+;;;    - Garbage collection.  Try turning it off, then running your code.
+;;;      Be warned that monitoring code will probably cons when it does
+;;;      (get-internal-run-time).
+;;;    - Swapping.  If you have enough memory, execute your form once
+;;;      before monitoring so that it will be swapped into memory. Otherwise,
+;;;      get a bigger machine!
+;;;    - Resolution of internal-time-units-per-second.  If this value is
+;;;      too low, then the timings become wild. You can try executing more
+;;;      of whatever your test is, but that will only work if some of your
+;;;      paths do not match the timer resolution.
+;;;      internal-time-units-per-second is so coarse -- on a Symbolics it is
+;;;      977, in MACL it is 60.
+;;;
+;;;
+
+;;; ****************************************************************
+;;; Interface ******************************************************
+;;; ****************************************************************
+;;;
+;;; WITH-MONITORING (&rest functions)                         [Macro]
+;;;                 (&optional (nested :exclusive)
+;;;                            (threshold 0.01)
+;;;                            (key :percent-time))
+;;;                 &body body
+;;; The named functions will be set up for monitoring, the body forms executed,
+;;; a table of results printed, and the functions unmonitored. The nested,
+;;; threshold, and key arguments are passed to report-monitoring below.
+;;;
+;;; MONITOR-FORM form                                         [Macro]
+;;;               &optional (nested :exclusive)
+;;;                         (threshold 0.01)
+;;;                         (key :percent-time)
+;;; All functions in the current package are set up for monitoring while
+;;; the form is executed, and automatically unmonitored after a table of
+;;; results has been printed. The nested, threshold, and key arguments
+;;; are passed to report-monitoring below.
+;;;
+;;; *MONITORED-FUNCTIONS*                                     [Variable]
+;;; This holds a list of all functions that are currently being monitored.
+;;;
+;;; MONITOR &rest names                                       [Macro]
+;;; The named functions will be set up for monitoring by augmenting
+;;; their function definitions with code that gathers statistical information
+;;; about code performance. As with the TRACE macro, the function names are
+;;; not evaluated. Calls the function MON::MONITORING-ENCAPSULATE on each
+;;; function name. If no names are specified, returns a list of all
+;;; monitored functions.
+;;;
+;;; If name is not a symbol, it is evaled to return the appropriate
+;;; closure. This allows you to monitor closures stored anywhere like
+;;; in a variable, array or structure. Most other monitoring packages
+;;; can't handle this.
+;;;
+;;; MONITOR-ALL &optional (package *package*)                 [Function]
+;;; Monitors all functions in the specified package, which defaults to
+;;; the current package.
+;;;
+;;; UNMONITOR &rest names                                     [Macro]
+;;; Removes monitoring code from the named functions. If no names are
+;;; specified, all currently monitored functions are unmonitored.
+;;;
+;;; RESET-MONITORING-INFO name                                [Function]
+;;; Resets the monitoring statistics for the specified function.
+;;;
+;;; RESET-ALL-MONITORING                                      [Function]
+;;; Resets the monitoring statistics for all monitored functions.
+;;;
+;;; MONITORED name                                            [Function]
+;;; Predicate to test whether a function is monitored.
+;;;
+;;; REPORT-MONITORING &optional names                         [Function]
+;;;                             (nested :exclusive)
+;;;                             (threshold 0.01)
+;;;                             (key :percent-time)
+;;; Creates a table of monitoring information for the specified list
+;;; of names, and displays the table using display-monitoring-results.
+;;; If names is :all or nil, uses all currently monitored functions.
+;;; Takes the following arguments:
+;;;    - NESTED specifies whether nested calls of monitored functions
+;;;      are included in the times for monitored functions.
+;;;      o  If :inclusive, the per-function information is for the entire
+;;;         duration of the monitored function, including any calls to
+;;;         other monitored functions. If functions A and B are monitored,
+;;;         and A calls B, then the accumulated time and consing for A will
+;;;         include the time and consing of B.  Note: if a function calls
+;;;         itself recursively, the time spent in the inner call(s) may
+;;;         be counted several times.
+;;;      o  If :exclusive, the information excludes time attributed to
+;;;         calls to other monitored functions. This is the default.
+;;;    - THRESHOLD specifies that only functions which have been executed
+;;;      more than threshold percent of the time will be reported. Defaults
+;;;      to 1%. If a threshold of 0 is specified, all functions are listed,
+;;;      even those with 0 or negative running times (see note on overhead).
+;;;    - KEY specifies that the table be sorted by one of the following
+;;;      sort keys:
+;;;         :function       alphabetically by function name
+;;;         :percent-time   by percent of total execution time
+;;;         :percent-cons   by percent of total consing
+;;;         :calls          by number of times the function was called
+;;;         :time-per-call  by average execution time per function
+;;;         :cons-per-call  by average consing per function
+;;;         :time           same as :percent-time
+;;;         :cons           same as :percent-cons
+;;;
+;;; REPORT &key (names :all)                                  [Function]
+;;;             (nested :exclusive)
+;;;             (threshold 0.01)
+;;;             (sort-key :percent-time)
+;;;             (ignore-no-calls nil)
+;;;
+;;; Same as REPORT-MONITORING but we use a nicer keyword interface.
+;;;
+;;; DISPLAY-MONITORING-RESULTS &optional (threshold 0.01)     [Function]
+;;;                                      (key :percent-time)
+;;; Prints a table showing for each named function:
+;;;    - the total CPU time used in that function for all calls
+;;;    - the total number of bytes consed in that function for all calls
+;;;    - the total number of calls
+;;;    - the average amount of CPU time per call
+;;;    - the average amount of consing per call
+;;;    - the percent of total execution time spent executing that function
+;;;    - the percent of total consing spent consing in that function
+;;; Summary totals of the CPU time, consing, and calls columns are printed.
+;;; An estimate of the monitoring overhead is also printed. May be run
+;;; even after unmonitoring all the functions, to play with the data.
+;;;
+;;; SAMPLE TABLE:
+#|
+                                               Cons
+                 %     %                       Per      Total   Total
+Function         Time  Cons  Calls  Sec/Call   Call     Time    Cons
+----------------------------------------------------------------------
+FIND-ROLE:       0.58  0.00    136  0.003521      0  0.478863       0
+GROUP-ROLE:      0.35  0.00    365  0.000802      0  0.292760       0
+GROUP-PROJECTOR: 0.05  0.00    102  0.000408      0  0.041648       0
+FEATURE-P:       0.02  0.00    570  0.000028      0  0.015680       0
+----------------------------------------------------------------------
+TOTAL:                        1173                   0.828950       0
+Estimated total monitoring overhead: 0.88 seconds
+|#
+
+;;; ****************************************************************
+;;; METERING *******************************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Warn people using the wrong Lisp
+;;; ********************************
+
+#-(or clisp openmcl)
+(warn "metering.lisp does not support your Lisp implementation!")
+
+;;; ********************************
+;;; Packages ***********************
+;;; ********************************
+
+;;; For CLtL2 compatible lisps
+
+(defpackage "MONITOR" (:nicknames "MON") (:use "COMMON-LISP")
+  (:export "*MONITORED-FUNCTIONS*"
+	   "MONITOR" "MONITOR-ALL" "UNMONITOR" "MONITOR-FORM"
+	   "WITH-MONITORING"
+	   "RESET-MONITORING-INFO" "RESET-ALL-MONITORING"
+	   "MONITORED"
+	   "REPORT-MONITORING"
+	   "DISPLAY-MONITORING-RESULTS"
+	   "MONITORING-ENCAPSULATE" "MONITORING-UNENCAPSULATE"
+	   "REPORT"))
+(in-package "MONITOR")
+
+;;; Warn user if they're loading the source instead of compiling it first.
+(eval-when (eval)
+   (warn "This file should be compiled before loading for best results."))
+
+;;; ********************************
+;;; Version ************************
+;;; ********************************
+
+(defparameter *metering-version* "v2.1 25-JAN-94"
+  "Current version number/date for Metering.")
+
+
+;;; ****************************************************************
+;;; Implementation Dependent Definitions ***************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Timing Functions ***************
+;;; ********************************
+;;; The get-time function is called to find the total number of ticks since
+;;; the beginning of time. time-units-per-second allows us to convert units
+;;; to seconds.
+
+#-(or clisp openmcl)
+(eval-when (compile eval)
+  (warn
+   "You may want to supply implementation-specific get-time functions."))
+
+(defconstant time-units-per-second internal-time-units-per-second)
+
+(defmacro get-time ()
+  `(the time-type (get-internal-run-time)))
+
+;;; NOTE: In Macintosh Common Lisp, CCL::GCTIME returns the number of
+;;;       milliseconds spent during GC. We could subtract this from
+;;;       the value returned by get-internal-run-time to eliminate
+;;;       the effect of GC on the timing values, but we prefer to let
+;;;       the user run without GC on. If the application is so big that
+;;;       it requires GC to complete, then the GC times are part of the
+;;;       cost of doing business, and will average out in the long run.
+;;;       If it seems really important to a user that GC times not be
+;;;       counted, then uncomment the following three lines and read-time
+;;;       conditionalize the definition of get-time above with #-:openmcl.
+;#+openmcl
+;(defmacro get-time ()
+;  `(the time-type (- (get-internal-run-time) (ccl:gctime))))
+
+;;; ********************************
+;;; Consing Functions **************
+;;; ********************************
+;;; The get-cons macro is called to find the total number of bytes
+;;; consed since the beginning of time.
+
+#+clisp
+(defun get-cons ()
+  (multiple-value-bind (real1 real2 run1 run2 gc1 gc2 space1 space2 gccount)
+      (sys::%%time)
+    (declare (ignore real1 real2 run1 run2 gc1 gc2 gccount))
+    (dpb space1 (byte 24 24) space2)))
+
+;;; Macintosh Common Lisp 2.0
+;;; Note that this includes bytes that were allocated during GC.
+;;; We could subtract this out by advising GC like we did under
+;;; MCL 1.3.2, but I'd rather users ran without GC. If they can't
+;;; run without GC, then the bytes consed during GC are a cost of
+;;; running their program. Metering the code a few times will
+;;; avoid the consing values being too lopsided. If a user really really
+;;; wants to subtract out the consing during GC, replace the following
+;;; two lines with the commented out code.
+#+openmcl
+(defmacro get-cons () `(the consing-type (ccl::total-bytes-allocated)))
+;; #+openmcl
+;; (progn
+;;   (in-package :ccl)
+;;   (defvar *bytes-consed-chkpt* 0)
+;;   (defun reset-consing () (setq *bytes-consed-chkpt* 0))
+;;   (let ((old-gc (symbol-function 'gc))
+;;         (ccl:*warn-if-redefine-kernel* nil))
+;;     (setf (symbol-function 'gc)
+;;           #'(lambda ()
+;;               (let ((old-consing (total-bytes-consed)))
+;;                 (prog1
+;;                     (funcall old-gc)
+;;                   (incf *bytes-consed-chkpt*
+;;                         (- old-consing (total-bytes-consed))))))))
+;;   (defun total-bytes-consed ()
+;;     "Returns number of conses (8 bytes each)"
+;;     (ccl::total-bytes-allocated))
+;;   (in-package "MONITOR")
+;;   (defun get-cons ()
+;;     (the consing-type (+ (ccl::total-bytes-consed) ccl::*bytes-consed-chkpt*))))
+
+
+#-(or clisp openmcl)
+(progn
+  (eval-when (compile eval)
+    (warn "No consing will be reported unless a get-cons function is ~
+           defined."))
+
+  (defmacro get-cons () '(the consing-type 0)))
+
+;; actually, neither `get-cons' nor `get-time' are used as is,
+;; but only in the following macro `with-time/cons'
+#-:clisp
+(defmacro with-time/cons ((delta-time delta-cons) form &body post-process)
+  (let ((start-cons (gensym "START-CONS-"))
+        (start-time (gensym "START-TIME-")))
+    `(let ((,start-time (get-time)) (,start-cons (get-cons)))
+       (declare (type time-type ,start-time)
+                (type consing-type ,start-cons))
+       (multiple-value-prog1 ,form
+         (let ((,delta-time (- (get-time) ,start-time))
+               (,delta-cons (- (get-cons) ,start-cons)))
+           , at post-process)))))
+
+#+clisp
+(progn
+  (defmacro delta4 (nv1 nv2 ov1 ov2 by)
+    `(- (dpb (- ,nv1 ,ov1) (byte ,by ,by) ,nv2) ,ov2))
+
+  (let ((del (find-symbol "DELTA4" "SYS")))
+    (when del (setf (fdefinition 'delta4) (fdefinition del))))
+
+  (if (< internal-time-units-per-second 1000000)
+      ;; TIME_1: AMIGA, OS/2, UNIX_TIMES
+      (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2)
+        `(delta4 ,new-time1 ,new-time2 ,old-time1 ,old-time2 16))
+      ;; TIME_2: other UNIX, WIN32
+      (defmacro delta4-time (new-time1 new-time2 old-time1 old-time2)
+        `(+ (* (- ,new-time1 ,old-time1) internal-time-units-per-second)
+            (- ,new-time2 ,old-time2))))
+
+  (defmacro delta4-cons (new-cons1 new-cons2 old-cons1 old-cons2)
+    `(delta4 ,new-cons1 ,new-cons2 ,old-cons1 ,old-cons2 24))
+
+  ;; avoid consing: when the application conses a lot,
+  ;; get-cons may return a bignum, so we really should not use it.
+  (defmacro with-time/cons ((delta-time delta-cons) form &body post-process)
+    (let ((beg-cons1 (gensym "BEG-CONS1-")) (end-cons1 (gensym "END-CONS1-"))
+          (beg-cons2 (gensym "BEG-CONS2-")) (end-cons2 (gensym "END-CONS2-"))
+          (beg-time1 (gensym "BEG-TIME1-")) (end-time1 (gensym "END-TIME1-"))
+          (beg-time2 (gensym "BEG-TIME2-")) (end-time2 (gensym "END-TIME2-"))
+          (re1 (gensym)) (re2 (gensym)) (gc1 (gensym)) (gc2 (gensym)))
+      `(multiple-value-bind (,re1 ,re2 ,beg-time1 ,beg-time2
+                                  ,gc1 ,gc2 ,beg-cons1 ,beg-cons2) (sys::%%time)
+         (declare (ignore ,re1 ,re2 ,gc1 ,gc2))
+         (multiple-value-prog1 ,form
+           (multiple-value-bind (,re1 ,re2 ,end-time1 ,end-time2
+                                      ,gc1 ,gc2 ,end-cons1 ,end-cons2) (sys::%%time)
+             (declare (ignore ,re1 ,re2 ,gc1 ,gc2))
+             (let ((,delta-time (delta4-time ,end-time1 ,end-time2
+                                             ,beg-time1 ,beg-time2))
+                   (,delta-cons (delta4-cons ,end-cons1 ,end-cons2
+                                             ,beg-cons1 ,beg-cons2)))
+               , at post-process)))))))
+
+;;; ********************************
+;;; Required Arguments *************
+;;; ********************************
+;;;
+;;; Required (Fixed) vs Optional Args
+;;;
+;;; To avoid unnecessary consing in the "encapsulation" code, we find out the
+;;; number of required arguments, and use &rest to capture only non-required
+;;; arguments.  The function Required-Arguments returns two values: the first
+;;; is the number of required arguments, and the second is T iff there are any
+;;; non-required arguments (e.g. &optional, &rest, &key).
+
+;;; Lucid, Allegro, and Macintosh Common Lisp
+#+openmcl
+(defun required-arguments (name)
+  (let* ((function (symbol-function name))
+         (args (ccl:arglist function))
+         (pos (position-if #'(lambda (x)
+                               (and (symbolp x)
+                                    (let ((name (symbol-name x)))
+                                      (and (>= (length name) 1)
+                                           (char= (schar name 0)
+                                                  #\&)))))
+                           args)))
+    (if pos
+        (values pos t)
+        (values (length args) nil))))
+
+#+clisp
+(defun required-arguments (name)
+  (multiple-value-bind (name req-num opt-num rest-p key-p keywords allow-p)
+      (sys::function-signature name t)
+    (if name ; no error
+        (values req-num (or (/= 0 opt-num) rest-p key-p keywords allow-p))
+        (values 0 t))))
+
+#-(or clisp openmcl)
+(progn
+ (eval-when (compile eval)
+   (warn
+    "You may want to add an implementation-specific Required-Arguments function."))
+ (eval-when (load eval)
+   (defun required-arguments (name)
+     (declare (ignore name))
+     (values 0 t))))
+
+#|
+;;;Examples
+(defun square (x) (* x x))
+(defun square2 (x &optional y) (* x x y))
+(defun test (x y &optional (z 3)) 3)
+(defun test2 (x y &optional (z 3) &rest fred) 3)
+
+(required-arguments 'square) => 1 nil
+(required-arguments 'square2) => 1 t
+(required-arguments 'test) => 2 t
+(required-arguments 'test2) => 2 t
+|#
+
+
+;;; ****************************************************************
+;;; Main METERING Code *********************************************
+;;; ****************************************************************
+
+;;; ********************************
+;;; Global Variables ***************
+;;; ********************************
+(defvar *MONITOR-TIME-OVERHEAD* nil
+  "The amount of time an empty monitored function costs.")
+(defvar *MONITOR-CONS-OVERHEAD* nil
+  "The amount of cons an empty monitored function costs.")
+
+(defvar *TOTAL-TIME* 0
+  "Total amount of time monitored so far.")
+(defvar *TOTAL-CONS* 0
+  "Total amount of consing monitored so far.")
+(defvar *TOTAL-CALLS* 0
+  "Total number of calls monitored so far.")
+(proclaim '(type time-type *total-time*))
+(proclaim '(type consing-type *total-cons*))
+(proclaim '(fixnum *total-calls*))
+
+;;; ********************************
+;;; Accessor Functions *************
+;;; ********************************
+;;; Perhaps the SYMBOLP should be FBOUNDP? I.e., what about variables
+;;; containing closures.
+(defmacro PLACE-FUNCTION (function-place)
+  "Return the function found at FUNCTION-PLACE. Evals FUNCTION-PLACE
+if it isn't a symbol, to allow monitoring of closures located in
+variables/arrays/structures."
+  ;; Note that (fboundp 'fdefinition) returns T even if fdefinition
+  ;; is a macro, which is what we want.
+  (if (fboundp 'fdefinition)
+      `(if (fboundp ,function-place)
+           (fdefinition ,function-place)
+           (eval ,function-place))
+      `(if (symbolp ,function-place)
+           (symbol-function ,function-place)
+           (eval ,function-place))))
+
+(defsetf PLACE-FUNCTION (function-place) (function)
+  "Set the function in FUNCTION-PLACE to FUNCTION."
+  (if (fboundp 'fdefinition)
+      ;; If we're conforming to CLtL2, use fdefinition here.
+      `(if (fboundp ,function-place)
+           (setf (fdefinition ,function-place) ,function)
+           (eval '(setf ,function-place ',function)))
+      `(if (symbolp ,function-place)
+           (setf (symbol-function ,function-place) ,function)
+           (eval '(setf ,function-place ',function)))))
+
+#|
+;;; before using fdefinition
+(defun PLACE-FUNCTION (function-place)
+  "Return the function found at FUNCTION-PLACE. Evals FUNCTION-PLACE
+if it isn't a symbol, to allow monitoring of closures located in
+variables/arrays/structures."
+  (if (symbolp function-place)
+      (symbol-function function-place)
+      (eval function-place)))
+
+(defsetf PLACE-FUNCTION (function-place) (function)
+  "Set the function in FUNCTION-PLACE to FUNCTION."
+  `(if (symbolp ,function-place)
+       (setf (symbol-function ,function-place) ,function)
+       (eval '(setf ,function-place ',function))))
+|#
+
+(defun PLACE-FBOUNDP (function-place)
+  "Test to see if FUNCTION-PLACE is a function."
+  ;; probably should be
+  #|(or (and (symbolp function-place)(fboundp function-place))
+      (functionp (place-function function-place)))|#
+  (if (symbolp function-place)
+      (fboundp function-place)
+      (functionp (place-function function-place))))
+
+(defun PLACE-MACROP (function-place)
+  "Test to see if FUNCTION-PLACE is a macro."
+  (when (symbolp function-place)
+    (macro-function function-place)))
+
+;;; ********************************
+;;; Measurement Tables *************
+;;; ********************************
+(defvar *monitored-functions* nil
+  "List of monitored symbols.")
+
+;;; We associate a METERING-FUNCTIONS structure with each monitored function
+;;; name or other closure. This holds the functions that we call to manipulate
+;;; the closure which implements the encapsulation.
+;;;
+(defstruct metering-functions
+  (name nil)
+  (old-definition nil :type function)
+  (new-definition nil :type function)
+  (read-metering  nil :type function)
+  (reset-metering nil :type function))
+
+;;; In general using hash tables in time-critical programs is a bad idea,
+;;; because when one has to grow the table and rehash everything, the
+;;; timing becomes grossly inaccurate. In this case it is not an issue
+;;; because all inserting of entries in the hash table occurs before the
+;;; timing commences. The only circumstance in which this could be a
+;;; problem is if the lisp rehashes on the next reference to the table,
+;;; instead of when the entry which forces a rehash was inserted.
+;;;
+;;; Note that a similar kind of problem can occur with GC, which is why
+;;; one should turn off GC when monitoring code.
+;;;
+(defvar *monitor* (make-hash-table :test #'equal)
+  "Hash table in which METERING-FUNCTIONS structures are stored.")
+(defun get-monitor-info (name)
+  (gethash name *monitor*))
+(defsetf get-monitor-info (name) (info)
+  `(setf (gethash ,name *monitor*) ,info))
+
+(defun MONITORED (function-place)
+  "Test to see if a FUNCTION-PLACE is monitored."
+  (and (place-fboundp function-place)   ; this line necessary?
+       (get-monitor-info function-place)))
+
+(defun reset-monitoring-info (name)
+  "Reset the monitoring info for the specified function."
+  (let ((finfo (get-monitor-info name)))
+    (when finfo
+      (funcall (metering-functions-reset-metering finfo)))))
+(defun reset-all-monitoring ()
+  "Reset monitoring info for all functions."
+  (setq *total-time* 0
+        *total-cons* 0
+        *total-calls* 0)
+  (dolist (symbol *monitored-functions*)
+    (when (monitored symbol)
+      (reset-monitoring-info symbol))))
+
+(defun monitor-info-values (name &optional (nested :exclusive) warn)
+  "Returns monitoring information values for the named function,
+adjusted for overhead."
+  (let ((finfo (get-monitor-info name)))
+    (if finfo
+        (multiple-value-bind (inclusive-time inclusive-cons
+                                             exclusive-time exclusive-cons
+                                             calls nested-calls)
+            (funcall (metering-functions-read-metering finfo))
+          (unless (or (null warn)
+                      (eq (place-function name)
+                          (metering-functions-new-definition finfo)))
+            (warn "Funtion ~S has been redefined, so times may be inaccurate.~@
+                   MONITOR it again to record calls to the new definition."
+                  name))
+          (case nested
+            (:exclusive (values calls
+                                nested-calls
+                                (- exclusive-time
+                                   (* calls *monitor-time-overhead*))
+                                (- exclusive-cons
+                                   (* calls *monitor-cons-overhead*))))
+            ;; In :inclusive mode, subtract overhead for all the
+            ;; called functions as well. Nested-calls includes the
+            ;; calls of the function as well. [Necessary 'cause of
+            ;; functions which call themselves recursively.]
+            (:inclusive (values calls
+                                nested-calls
+                                (- inclusive-time
+                                   (* nested-calls ;(+ calls)
+                                      *monitor-time-overhead*))
+                                (- inclusive-cons
+                                   (* nested-calls ;(+ calls)
+                                      *monitor-cons-overhead*))))))
+        (values 0 0 0 0))))
+
+;;; ********************************
+;;; Encapsulate ********************
+;;; ********************************
+(eval-when (compile load eval)
+;; Returns a lambda expression for a function that, when called with the
+;; function name, will set up that function for metering.
+;;
+;; A function is monitored by replacing its definition with a closure
+;; created by the following function. The closure records the monitoring
+;; data, and updates the data with each call of the function.
+;;
+;; Other closures are used to read and reset the data.
+(defun make-monitoring-encapsulation (min-args optionals-p)
+  (let (required-args)
+    (dotimes (i min-args) (push (gensym) required-args))
+    `(lambda (name)
+       (let ((inclusive-time 0)
+	     (inclusive-cons 0)
+	     (exclusive-time 0)
+	     (exclusive-cons 0)
+	     (calls 0)
+	     (nested-calls 0)
+	     (old-definition (place-function name)))
+	 (declare (type time-type inclusive-time)
+		  (type time-type exclusive-time)
+		  (type consing-type inclusive-cons)
+		  (type consing-type exclusive-cons)
+		  (fixnum calls)
+		  (fixnum nested-calls))
+	 (pushnew name *monitored-functions*)
+
+	 (setf (place-function name)
+	       #'(lambda (, at required-args
+			  ,@(when optionals-p
+                              `(&rest optional-args)))
+		   (let ((prev-total-time *total-time*)
+			 (prev-total-cons *total-cons*)
+			 (prev-total-calls *total-calls*)
+			 ;; (old-time inclusive-time)
+			 ;; (old-cons inclusive-cons)
+			 ;; (old-nested-calls nested-calls)
+			 )
+		     (declare (type time-type prev-total-time)
+			      (type consing-type prev-total-cons)
+			      (fixnum prev-total-calls))
+                     (with-time/cons (delta-time delta-cons)
+                       ;; form
+                       ,(if optionals-p
+                            `(apply old-definition
+                                    , at required-args optional-args)
+                            `(funcall old-definition , at required-args))
+                       ;; post-processing:
+                       ;; Calls
+                       (incf calls)
+                       (incf *total-calls*)
+                       ;; nested-calls includes this call
+                       (incf nested-calls (the fixnum
+                                            (- *total-calls*
+                                               prev-total-calls)))
+                       ;; (setf nested-calls (+ old-nested-calls
+                       ;;                       (- *total-calls*
+                       ;;                          prev-total-calls)))
+                       ;; Time
+                       ;; Problem with inclusive time is that it
+                       ;; currently doesn't add values from recursive
+                       ;; calls to the same function. Change the
+                       ;; setf to an incf to fix this?
+                       (incf inclusive-time (the time-type delta-time))
+                       ;; (setf inclusive-time (+ delta-time old-time))
+                       (incf exclusive-time (the time-type
+                                              (+ delta-time
+                                                 (- prev-total-time
+                                                    *total-time*))))
+                       (setf *total-time* (the time-type
+                                            (+ delta-time
+                                               prev-total-time)))
+                       ;; Consing
+                       (incf inclusive-cons (the consing-type delta-cons))
+                       ;; (setf inclusive-cons (+ delta-cons old-cons))
+                       (incf exclusive-cons (the consing-type
+                                              (+ delta-cons
+                                                 (- prev-total-cons
+                                                    *total-cons*))))
+                       (setf *total-cons*
+                             (the consing-type
+                               (+ delta-cons prev-total-cons)))))))
+	 (setf (get-monitor-info name)
+	       (make-metering-functions
+		:name name
+		:old-definition old-definition
+		:new-definition (place-function name)
+		:read-metering #'(lambda ()
+				   (values inclusive-time
+					   inclusive-cons
+					   exclusive-time
+					   exclusive-cons
+					   calls
+					   nested-calls))
+		:reset-metering #'(lambda ()
+				    (setq inclusive-time 0
+					  inclusive-cons 0
+					  exclusive-time 0
+					  exclusive-cons 0
+					  calls 0
+					  nested-calls 0)
+				    t)))))))
+);; End of EVAL-WHEN
+
+;;; For efficiency reasons, we precompute the encapsulation functions
+;;; for a variety of combinations of argument structures
+;;; (min-args . optional-p). These are stored in the following hash table
+;;; along with any new ones we encounter. Since we're now precomputing
+;;; closure functions for common argument signatures, this eliminates
+;;; the former need to call COMPILE for each monitored function.
+(eval-when (compile eval)
+   (defconstant precomputed-encapsulations 8))
+
+(defvar *existing-encapsulations* (make-hash-table :test #'equal))
+(defun find-encapsulation (min-args optionals-p)
+  (or (gethash (cons min-args optionals-p) *existing-encapsulations*)
+      (setf (gethash (cons min-args optionals-p) *existing-encapsulations*)
+            (compile nil
+                     (make-monitoring-encapsulation min-args optionals-p)))))
+
+(macrolet ((frob ()
+             (let ((res ()))
+               (dotimes (i precomputed-encapsulations)
+                 (push `(setf (gethash '(,i . nil) *existing-encapsulations*)
+                              #',(make-monitoring-encapsulation i nil))
+                       res)
+                 (push `(setf (gethash '(,i . t) *existing-encapsulations*)
+                              #',(make-monitoring-encapsulation i t))
+                       res))
+               `(progn , at res))))
+  (frob))
+
+(defun monitoring-encapsulate (name &optional warn)
+  "Monitor the function Name. If already monitored, unmonitor first."
+  ;; Saves the current definition of name and inserts a new function which
+  ;; returns the result of evaluating body.
+  (cond ((not (place-fboundp name))     ; not a function
+         (when warn
+           (warn "Ignoring undefined function ~S." name)))
+        ((place-macrop name)            ; a macro
+         (when warn
+           (warn "Ignoring macro ~S." name)))
+        (t                              ; tis a function
+         (when (get-monitor-info name) ; monitored
+           (when warn
+             (warn "~S already monitored, so unmonitoring it first." name))
+           (monitoring-unencapsulate name))
+         (multiple-value-bind (min-args optionals-p)
+             (required-arguments name)
+           (funcall (find-encapsulation min-args optionals-p) name)))))
+
+(defun monitoring-unencapsulate (name &optional warn)
+  "Removes monitoring encapsulation code from around Name."
+  (let ((finfo (get-monitor-info name)))
+    (when finfo                         ; monitored
+      (remprop name 'metering-functions)
+      (setq *monitored-functions*
+            (remove name *monitored-functions* :test #'equal))
+      (if (eq (place-function name)
+              (metering-functions-new-definition finfo))
+          (setf (place-function name)
+                (metering-functions-old-definition finfo))
+          (when warn
+            (warn "Preserving current definition of redefined function ~S."
+                  name))))))
+
+;;; ********************************
+;;; Main Monitoring Functions ******
+;;; ********************************
+(defmacro MONITOR (&rest names)
+  "Monitor the named functions. As in TRACE, the names are not evaluated.
+   If a function is already monitored, then unmonitor and remonitor (useful
+   to notice function redefinition). If a name is undefined, give a warning
+   and ignore it. See also unmonitor, report-monitoring,
+   display-monitoring-results and reset-time."
+  `(progn
+     ,@(mapcar #'(lambda (name) `(monitoring-encapsulate ',name)) names)
+     *monitored-functions*))
+
+(defmacro UNMONITOR (&rest names)
+  "Remove the monitoring on the named functions.
+   Names defaults to the list of all currently monitored functions."
+  `(dolist (name ,(if names `',names '*monitored-functions*) (values))
+     (monitoring-unencapsulate name)))
+
+(defun MONITOR-ALL (&optional (package *package*))
+  "Monitor all functions in the specified package."
+  (let ((package (if (packagep package)
+		     package
+		     (find-package package))))
+    (do-symbols (symbol package)
+      (when (eq (symbol-package symbol) package)
+        (monitoring-encapsulate symbol)))))
+
+(defmacro MONITOR-FORM (form
+                        &optional (nested :exclusive) (threshold 0.01)
+                        (key :percent-time))
+  "Monitor the execution of all functions in the current package
+during the execution of FORM.  All functions that are executed above
+THRESHOLD % will be reported."
+  `(unwind-protect
+       (progn
+         (monitor-all)
+         (reset-all-monitoring)
+         (prog1
+             (time ,form)
+           (report-monitoring :all ,nested ,threshold ,key :ignore-no-calls)))
+     (unmonitor)))
+
+(defmacro WITH-MONITORING ((&rest functions)
+                           (&optional (nested :exclusive)
+                                      (threshold 0.01)
+                                      (key :percent-time))
+                           &body body)
+  "Monitor the specified functions during the execution of the body."
+  `(unwind-protect
+       (progn
+         (dolist (fun ',functions)
+           (monitoring-encapsulate fun))
+         (reset-all-monitoring)
+         , at body
+         (report-monitoring :all ,nested ,threshold ,key))
+     (unmonitor)))
+
+;;; ********************************
+;;; Overhead Calculations **********
+;;; ********************************
+(defconstant overhead-iterations 5000
+  "Number of iterations over which the timing overhead is averaged.")
+
+;;; Perhaps this should return something to frustrate clever compilers.
+(defun STUB-FUNCTION (x)
+  (declare (ignore x))
+  nil)
+(proclaim '(notinline stub-function))
+
+(defun SET-MONITOR-OVERHEAD ()
+  "Determines the average overhead of monitoring by monitoring the execution
+of an empty function many times."
+  (setq *monitor-time-overhead* 0
+        *monitor-cons-overhead* 0)
+  (stub-function nil)
+  (monitor stub-function)
+  (reset-all-monitoring)
+  (let ((overhead-function (symbol-function 'stub-function)))
+    (dotimes (x overhead-iterations)
+      (funcall overhead-function overhead-function)))
+;  (dotimes (x overhead-iterations)
+;    (stub-function nil))
+  (let ((fiter (float overhead-iterations)))
+    (multiple-value-bind (calls nested-calls time cons)
+        (monitor-info-values 'stub-function)
+      (declare (ignore calls nested-calls))
+      (setq *monitor-time-overhead* (/ time fiter)
+            *monitor-cons-overhead* (/ cons fiter))))
+  (unmonitor stub-function))
+(set-monitor-overhead)
+
+;;; ********************************
+;;; Report Data ********************
+;;; ********************************
+(defvar *monitor-results* nil
+  "A table of monitoring statistics is stored here.")
+(defvar *no-calls* nil
+  "A list of monitored functions which weren't called.")
+(defvar *estimated-total-overhead* 0)
+;; (proclaim '(type time-type *estimated-total-overhead*))
+
+(defstruct (monitoring-info
+            (:conc-name m-info-)
+            (:constructor make-monitoring-info
+                          (name calls time cons
+                                percent-time percent-cons
+                                time-per-call cons-per-call)))
+  name
+  calls
+  time
+  cons
+  percent-time
+  percent-cons
+  time-per-call
+  cons-per-call)
+
+(defun REPORT (&key (names :all)
+		    (nested :exclusive)
+		    (threshold 0.01)
+		    (sort-key :percent-time)
+		    (ignore-no-calls nil))
+  "Same as REPORT-MONITORING but with a nicer keyword interface"
+  (declare (type (member :function :percent-time :time :percent-cons
+			 :cons :calls :time-per-call :cons-per-call)
+		 sort-key)
+	   (type (member :inclusive :exclusive) nested))
+  (report-monitoring names nested threshold sort-key ignore-no-calls))
+
+(defun REPORT-MONITORING (&optional names
+				    (nested :exclusive)
+				    (threshold 0.01)
+				    (key :percent-time)
+				    ignore-no-calls)
+  "Report the current monitoring state.
+The percentage of the total time spent executing unmonitored code
+in each function (:exclusive mode), or total time (:inclusive mode)
+will be printed together with the number of calls and
+the unmonitored time per call.  Functions that have been executed
+below THRESHOLD % of the time will not be reported.  To report on all
+functions set NAMES to be either NIL or :ALL."
+  (when (or (null names) (eq names :all)) (setq names *monitored-functions*))
+
+  (let ((total-time 0)
+        (total-cons 0)
+        (total-calls 0))
+    ;; Compute overall time and consing.
+    (dolist (name names)
+      (multiple-value-bind (calls nested-calls time cons)
+          (monitor-info-values name nested :warn)
+        (declare (ignore nested-calls))
+        (incf total-calls calls)
+        (incf total-time time)
+        (incf total-cons cons)))
+    ;; Total overhead.
+    (setq *estimated-total-overhead*
+          (/ (* *monitor-time-overhead* total-calls)
+             time-units-per-second))
+    ;; Assemble data for only the specified names (all monitored functions)
+    (if (zerop total-time)
+        (format *trace-output* "Not enough execution time to monitor.")
+        (progn
+          (setq *monitor-results* nil *no-calls* nil)
+          (dolist (name names)
+            (multiple-value-bind (calls nested-calls time cons)
+                (monitor-info-values name nested)
+              (declare (ignore nested-calls))
+              (when (minusp time) (setq time 0.0))
+              (when (minusp cons) (setq cons 0.0))
+              (if (zerop calls)
+                  (push (if (symbolp name)
+                            (symbol-name name)
+                            (format nil "~S" name))
+                        *no-calls*)
+                  (push (make-monitoring-info
+                         (format nil "~S" name) ; name
+                         calls          ; calls
+                         (/ time (float time-units-per-second)) ; time in secs
+                         (round cons)   ; consing
+                         (/ time (float total-time)) ; percent-time
+                         (if (zerop total-cons) 0
+                             (/ cons (float total-cons))) ; percent-cons
+                         (/ (/ time (float calls)) ; time-per-call
+                            time-units-per-second) ; sec/call
+                         (round (/ cons (float calls)))) ; cons-per-call
+                        *monitor-results*))))
+          (display-monitoring-results threshold key ignore-no-calls)))))
+
+(defun display-monitoring-results (&optional (threshold 0.01) (key :percent-time)
+					     (ignore-no-calls t))
+  (let ((max-length 8)			; Function header size
+	(max-cons-length 8)
+	(total-time 0.0)
+	(total-consed 0)
+	(total-calls 0)
+	(total-percent-time 0)
+	(total-percent-cons 0))
+    (sort-results key)
+    (dolist (result *monitor-results*)
+      (when (or (zerop threshold)
+		(> (m-info-percent-time result) threshold))
+	(setq max-length
+	      (max max-length
+		   (length (m-info-name result))))
+	(setq max-cons-length
+	      (max max-cons-length
+		   (m-info-cons-per-call result)))))
+    (incf max-length 2)
+    (setf max-cons-length (+ 2 (ceiling (log max-cons-length 10))))
+    (format *trace-output*
+	    "~%~%~
+                       ~VT                                     ~VA~
+	     ~%        ~VT   %      %                          ~VA  Total     Total~
+	     ~%Function~VT  Time   Cons    Calls  Sec/Call     ~VA  Time      Cons~
+             ~%~V,,,'-A"
+	    max-length
+	    max-cons-length "Cons"
+	    max-length
+	    max-cons-length "Per"
+	    max-length
+	    max-cons-length "Call"
+	    (+ max-length 62 (max 0 (- max-cons-length 5))) "-")
+    (dolist (result *monitor-results*)
+      (when (or (zerop threshold)
+		(> (m-info-percent-time result) threshold))
+	(format *trace-output*
+		"~%~A:~VT~6,2F  ~6,2F  ~7D  ~,6F  ~VD  ~8,3F  ~10D"
+		(m-info-name result)
+		max-length
+		(* 100 (m-info-percent-time result))
+		(* 100 (m-info-percent-cons result))
+		(m-info-calls result)
+		(m-info-time-per-call result)
+		max-cons-length
+		(m-info-cons-per-call result)
+		(m-info-time result)
+		(m-info-cons result))
+	(incf total-time (m-info-time result))
+	(incf total-consed (m-info-cons result))
+	(incf total-calls (m-info-calls result))
+	(incf total-percent-time (m-info-percent-time result))
+	(incf total-percent-cons (m-info-percent-cons result))))
+    (format *trace-output*
+	    "~%~V,,,'-A~
+	    ~%TOTAL:~VT~6,2F  ~6,2F  ~7D  ~9 at T ~VA  ~8,3F  ~10D~
+            ~%Estimated monitoring overhead: ~5,2F seconds~
+            ~%Estimated total monitoring overhead: ~5,2F seconds"
+	    (+ max-length 62 (max 0 (- max-cons-length 5))) "-"
+	    max-length
+	    (* 100 total-percent-time)
+	    (* 100 total-percent-cons)
+	    total-calls
+	    max-cons-length " "
+	    total-time total-consed
+	    (/ (* *monitor-time-overhead* total-calls)
+	       time-units-per-second)
+	    *estimated-total-overhead*)
+    (when (and (not ignore-no-calls) *no-calls*)
+      (setq *no-calls* (sort *no-calls* #'string<))
+      (let ((num-no-calls (length *no-calls*)))
+        (if (> num-no-calls 20)
+            (format *trace-output*
+                    "~%~@(~r~) monitored functions were not called. ~
+                      ~%See the variable mon::*no-calls* for a list."
+                    num-no-calls)
+            (format *trace-output*
+                    "~%The following monitored functions were not called:~
+                ~%~{~<~%~:; ~A~>~}~%"
+                    *no-calls*))))
+    (values)))
+
+(defun sort-results (&optional (key :percent-time))
+  (setq *monitor-results*
+        (case key
+          (:function             (sort *monitor-results* #'string>
+                                       :key #'m-info-name))
+          ((:percent-time :time) (sort *monitor-results* #'>
+                                       :key #'m-info-time))
+          ((:percent-cons :cons) (sort *monitor-results* #'>
+                                       :key #'m-info-cons))
+          (:calls                (sort *monitor-results* #'>
+                                       :key #'m-info-calls))
+          (:time-per-call        (sort *monitor-results* #'>
+                                       :key #'m-info-time-per-call))
+          (:cons-per-call        (sort *monitor-results* #'>
+                                       :key #'m-info-cons-per-call)))))
+
+;;; *END OF FILE*
+
+

Added: branches/trunk-reorg/thirdparty/slime/mkdist.sh
===================================================================
--- branches/trunk-reorg/thirdparty/slime/mkdist.sh	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/mkdist.sh	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,17 @@
+#!/bin/sh
+
+# This code has been placed in the Public Domain.  All warranties
+# are disclaimed.
+
+version="1.2"
+dist="slime-$version"
+
+if [ -d $dist ]; then rm -rf $dist; fi
+
+mkdir $dist
+cp NEWS README HACKING PROBLEMS ChangeLog *.el *.lisp $dist/
+
+mkdir $dist/doc
+cp doc/Makefile doc/slime.texi doc/texinfo-tabulate.awk $dist/doc
+
+tar czf $dist.tar.gz $dist


Property changes on: branches/trunk-reorg/thirdparty/slime/mkdist.sh
___________________________________________________________________
Name: svn:executable
   + *

Added: branches/trunk-reorg/thirdparty/slime/nregex.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/nregex.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/nregex.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,523 @@
+;;;
+;;; This code was written by:
+;;;
+;;;    Lawrence E. Freil <lef at freil.com>
+;;;    National Science Center Foundation
+;;;    Augusta, Georgia 30909
+;;;
+;;; This program was released into the public domain on 2005-08-31.
+;;; (See the slime-devel mailing list archive for details.)
+;;;
+;;; nregex.lisp - My 4/8/92 attempt at a Lisp based regular expression
+;;;               parser. 
+;;;
+;;;               This regular expression parser operates by taking a
+;;;               regular expression and breaking it down into a list
+;;;               consisting of lisp expressions and flags.  The list
+;;;               of lisp expressions is then taken in turned into a
+;;;               lambda expression that can be later applied to a
+;;;               string argument for parsing.
+;;;;
+;;;; Modifications made 6 March 2001 By Chris Double (chris at double.co.nz)
+;;;; to get working with Corman Lisp 1.42, add package statement and export
+;;;; relevant functions.
+;;;;
+
+(in-package :cl-user)
+
+;; Renamed to slime-nregex avoid name clashes with other versions of
+;; this file. -- he
+
+;;;; CND - 6/3/2001
+(defpackage slime-nregex
+  (:use #:common-lisp)
+  (:export 
+   #:regex
+   #:regex-compile
+  ))
+
+;;;; CND - 6/3/2001
+(in-package :slime-nregex)
+
+;;;
+;;; First we create a copy of macros to help debug the beast
+(eval-when (:compile-toplevel :load-toplevel :execute)
+(defvar *regex-debug* nil)		; Set to nil for no debugging code
+)
+
+(defmacro info (message &rest args)
+  (if *regex-debug*
+      `(format *standard-output* ,message , at args)))
+
+;;;
+;;; Declare the global variables for storing the paren index list.
+;;;
+(defvar *regex-groups* (make-array 10))
+(defvar *regex-groupings* 0)
+
+;;;
+;;; Declare a simple interface for testing.  You probably wouldn't want
+;;; to use this interface unless you were just calling this once.
+;;;
+(defun regex (expression string)
+  "Usage: (regex <expression> <string)
+   This function will call regex-compile on the expression and then apply
+   the string to the returned lambda list."
+  (let ((findit (cond ((stringp expression)
+		       (regex-compile expression))
+		      ((listp expression)
+		       expression)))
+	(result nil))
+    (if (not (funcall (if (functionp findit)
+			  findit
+			(eval `(function ,findit))) string))
+	(return-from regex nil))
+    (if (= *regex-groupings* 0)
+	(return-from regex t))
+    (dotimes (i *regex-groupings*)
+      (push (funcall 'subseq 
+		     string 
+		     (car (aref *regex-groups* i))
+		     (cadr (aref *regex-groups* i)))
+	    result))
+    (reverse result)))
+
+;;;
+;;; Declare some simple macros to make the code more readable.
+;;;
+(defvar *regex-special-chars* "?*+.()[]\\${}")
+
+(defmacro add-exp (list)
+  "Add an item to the end of expression"
+  `(setf expression (append expression ,list)))
+
+;;;
+;;; Define a function that will take a quoted character and return
+;;; what the real character should be plus how much of the source
+;;; string was used.  If the result is a set of characters, return an
+;;; array of bits indicating which characters should be set.  If the
+;;; expression is one of the sub-group matches return a
+;;; list-expression that will provide the match.  
+;;;
+(defun regex-quoted (char-string &optional (invert nil))
+  "Usage: (regex-quoted <char-string> &optional invert)
+       Returns either the quoted character or a simple bit vector of bits set for
+       the matching values"
+  (let ((first (char char-string 0))
+	(result (char char-string 0))
+	(used-length 1))
+    (cond ((eql first #\n)
+	   (setf result #\NewLine))
+	  ((eql first #\c)
+	   (setf result #\Return))
+	  ((eql first #\t)
+	   (setf result #\Tab))
+	  ((eql first #\d)
+	   (setf result #*0000000000000000000000000000000000000000000000001111111111000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+	  ((eql first #\D)
+	   (setf result #*1111111111111111111111111111111111111111111111110000000000111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+	  ((eql first #\w)
+	   (setf result #*0000000000000000000000000000000000000000000000001111111111000000011111111111111111111111111000010111111111111111111111111110000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+	  ((eql first #\W)
+	   (setf result #*1111111111111111111111111111111111111111111111110000000000111111100000000000000000000000000111101000000000000000000000000001111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+	  ((eql first #\b)
+	   (setf result #*0000000001000000000000000000000011000000000010100000000000100000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+	  ((eql first #\B)
+	   (setf result #*1111111110111111111111111111111100111111111101011111111111011111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+	  ((eql first #\s)
+	   (setf result #*0000000001100000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000))
+	  ((eql first #\S)
+	   (setf result #*1111111110011111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111))
+	  ((and (>= (char-code first) (char-code #\0))
+		(<= (char-code first) (char-code #\9)))
+	   (if (and (> (length char-string) 2)
+		    (and (>= (char-code (char char-string 1)) (char-code #\0))
+			 (<= (char-code (char char-string 1)) (char-code #\9))
+			 (>= (char-code (char char-string 2)) (char-code #\0))
+			 (<= (char-code (char char-string 2)) (char-code #\9))))
+	       ;;
+	       ;; It is a single character specified in octal
+	       ;;
+	       (progn 
+		 (setf result (do ((x 0 (1+ x))
+				   (return 0))
+				  ((= x 2) return)
+				(setf return (+ (* return 8)
+						(- (char-code (char char-string x))
+						   (char-code #\0))))))
+		 (setf used-length 3))
+	     ;;
+	     ;; We have a group number replacement.
+	     ;;
+	     (let ((group (- (char-code first) (char-code #\0))))
+	       (setf result `((let ((nstring (subseq string (car (aref *regex-groups* ,group))
+						     (cadr (aref *regex-groups* ,group)))))
+				(if (< length (+ index (length nstring)))
+				    (return-from compare nil))
+				(if (not (string= string nstring
+						  :start1 index
+						  :end1 (+ index (length nstring))))
+				    (return-from compare nil)
+				  (incf index (length nstring)))))))))
+	  (t 
+	   (setf result first)))
+    (if (and (vectorp result) invert)
+	(bit-xor result #*1111111110011111111111111111111101111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111 t))
+    (values result used-length)))
+
+;;;
+;;; Now for the main regex compiler routine.
+;;;
+(defun regex-compile (source &key (anchored nil))
+  "Usage: (regex-compile <expression> [ :anchored (t/nil) ])
+       This function take a regular expression (supplied as source) and
+       compiles this into a lambda list that a string argument can then
+       be applied to.  It is also possible to compile this lambda list
+       for better performance or to save it as a named function for later
+       use"
+  (info "Now entering regex-compile with \"~A\"~%" source)
+  ;;
+  ;; This routine works in two parts.
+  ;; The first pass take the regular expression and produces a list of 
+  ;; operators and lisp expressions for the entire regular expression.  
+  ;; The second pass takes this list and produces the lambda expression.
+  (let ((expression '())		; holder for expressions
+	(group 1)			; Current group index
+	(group-stack nil)		; Stack of current group endings
+	(result nil)			; holder for built expression.
+	(fast-first nil))		; holder for quick unanchored scan
+    ;;
+    ;; If the expression was an empty string then it alway
+    ;; matches (so lets leave early)
+    ;;
+    (if (= (length source) 0)
+	(return-from regex-compile
+		     '(lambda (&rest args)
+			(declare (ignore args))
+			t)))
+    ;;
+    ;; If the first character is a caret then set the anchored
+    ;; flags and remove if from the expression string.
+    ;;
+    (cond ((eql (char source 0) #\^)
+	   (setf source (subseq source 1))
+	   (setf anchored t)))
+    ;;
+    ;; If the first sequence is .* then also set the anchored flags.
+    ;; (This is purely for optimization, it will work without this).
+    ;;
+    (if (>= (length source) 2)
+	(if (string= source ".*" :start1 0 :end1 2)
+	    (setf anchored t)))
+    ;;
+    ;; Also, If this is not an anchored search and the first character is
+    ;; a literal, then do a quick scan to see if it is even in the string.
+    ;; If not then we can issue a quick nil, 
+    ;; otherwise we can start the search at the matching character to skip
+    ;; the checks of the non-matching characters anyway.
+    ;;
+    ;; If I really wanted to speed up this section of code it would be 
+    ;; easy to recognize the case of a fairly long multi-character literal
+    ;; and generate a Boyer-Moore search for the entire literal. 
+    ;;
+    ;; I generate the code to do a loop because on CMU Lisp this is about
+    ;; twice as fast a calling position.
+    ;;
+    (if (and (not anchored)
+	     (not (position (char source 0) *regex-special-chars*))
+	     (not (and (> (length source) 1)
+		       (position (char source 1) *regex-special-chars*))))
+	(setf fast-first `((if (not (dotimes (i length nil)
+				     (if (eql (char string i)
+					      ,(char source 0))
+					 (return (setf start i)))))
+			      (return-from final-return nil)))))
+    ;;
+    ;; Generate the very first expression to save the starting index
+    ;; so that group 0 will be the entire string matched always
+    ;;
+    (add-exp '((setf (aref *regex-groups* 0)
+		     (list index nil))))
+    ;;
+    ;; Loop over each character in the regular expression building the
+    ;; expression list as we go.
+    ;;
+    (do ((eindex 0 (1+ eindex)))
+	((= eindex (length source)))
+      (let ((current (char source eindex)))
+	(info "Now processing character ~A index = ~A~%" current eindex)
+	(case current
+	  ((#\.)
+	   ;;
+	   ;; Generate code for a single wild character
+	   ;;
+	   (add-exp '((if (>= index length)
+			  (return-from compare nil)
+			(incf index)))))
+	  ((#\$)
+	   ;;
+	   ;; If this is the last character of the expression then
+	   ;; anchor the end of the expression, otherwise let it slide
+	   ;; as a standard character (even though it should be quoted).
+	   ;;
+	   (if (= eindex (1- (length source)))
+	       (add-exp '((if (not (= index length))
+			      (return-from compare nil))))
+	     (add-exp '((if (not (and (< index length)
+				      (eql (char string index) #\$)))
+			    (return-from compare nil)
+			  (incf index))))))
+	  ((#\*)
+	   (add-exp '(ASTRISK)))
+
+	  ((#\+)
+	   (add-exp '(PLUS)))
+
+	  ((#\?)
+	   (add-exp '(QUESTION)))
+
+	  ((#\()
+	   ;;
+	   ;; Start a grouping.
+	   ;;
+	   (incf group)
+	   (push group group-stack)
+	   (add-exp `((setf (aref *regex-groups* ,(1- group)) 
+			    (list index nil))))
+	   (add-exp `(,group)))
+	  ((#\))
+	   ;;
+	   ;; End a grouping
+	   ;;
+	   (let ((group (pop group-stack)))
+	     (add-exp `((setf (cadr (aref *regex-groups* ,(1- group)))
+			      index)))
+	     (add-exp `(,(- group)))))
+	  ((#\[)
+	   ;;
+	   ;; Start of a range operation.
+	   ;; Generate a bit-vector that has one bit per possible character
+	   ;; and then on each character or range, set the possible bits.
+	   ;;
+	   ;; If the first character is carat then invert the set.
+	   (let* ((invert (eql (char source (1+ eindex)) #\^))
+		  (bitstring (make-array 256 :element-type 'bit
+					     :initial-element
+					        (if invert 1 0)))
+		  (set-char (if invert 0 1)))
+	     (if invert (incf eindex))
+	     (do ((x (1+ eindex) (1+ x)))
+		 ((eql (char source x) #\]) (setf eindex x))
+	       (info "Building range with character ~A~%" (char source x))
+	       (cond ((and (eql (char source (1+ x)) #\-)
+			   (not (eql (char source (+ x 2)) #\])))
+		      (if (>= (char-code (char source x))
+			     (char-code (char source (+ 2 x))))
+			  (error "Invalid range \"~A-~A\".  Ranges must be in acending order"
+				 (char source x) (char source (+ 2 x))))
+		      (do ((j (char-code (char source x)) (1+ j)))
+		       ((> j (char-code (char source (+ 2 x))))
+			(incf x 2))
+		     (info "Setting bit for char ~A code ~A~%" (code-char j) j)
+		     (setf (sbit bitstring j) set-char)))
+		     (t
+		      (cond ((not (eql (char source x) #\]))
+			     (let ((char (char source x)))
+			       ;;
+			       ;; If the character is quoted then find out what
+			       ;; it should have been
+			       ;;
+			       (if (eql (char source x) #\\ )
+				   (let ((length))
+				     (multiple-value-setq (char length)
+					 (regex-quoted (subseq source x) invert))
+				     (incf x length)))
+			       (info "Setting bit for char ~A code ~A~%" char (char-code char))
+			       (if (not (vectorp char))
+				   (setf (sbit bitstring (char-code (char source x))) set-char)
+				 (bit-ior bitstring char t))))))))
+	     (add-exp `((let ((range ,bitstring))
+			  (if (>= index length)
+			      (return-from compare nil))
+			  (if (= 1 (sbit range (char-code (char string index))))
+			      (incf index)
+			    (return-from compare nil)))))))
+	  ((#\\ )
+	   ;;
+	   ;; Intreprete the next character as a special, range, octal, group or 
+           ;; just the character itself.
+	   ;;
+	   (let ((length)
+		 (value))
+	     (multiple-value-setq (value length)
+		 (regex-quoted (subseq source (1+ eindex)) nil))
+	     (cond ((listp value)
+		    (add-exp value))
+		   ((characterp value)
+		    (add-exp `((if (not (and (< index length)
+					     (eql (char string index) 
+						  ,value)))
+				   (return-from compare nil)
+				 (incf index)))))
+		   ((vectorp value)
+		    (add-exp `((let ((range ,value))
+				 (if (>= index length)
+				     (return-from compare nil))
+				 (if (= 1 (sbit range (char-code (char string index))))
+				     (incf index)
+				   (return-from compare nil)))))))
+	     (incf eindex length)))
+	  (t
+	   ;;
+	   ;; We have a literal character.  
+	   ;; Scan to see how many we have and if it is more than one
+	   ;; generate a string= verses as single eql.
+	   ;;
+	   (let* ((lit "")
+		  (term (dotimes (litindex (- (length source) eindex) nil)
+			  (let ((litchar (char source (+ eindex litindex))))
+			    (if (position litchar *regex-special-chars*)
+				(return litchar)
+			      (progn
+				(info "Now adding ~A index ~A to lit~%" litchar 
+				      litindex)
+				(setf lit (concatenate 'string lit 
+						       (string litchar)))))))))
+	     (if (= (length lit) 1)
+		 (add-exp `((if (not (and (< index length)
+					  (eql (char string index) ,current)))
+				(return-from compare nil)
+			      (incf index))))
+	       ;;
+	       ;; If we have a multi-character literal then we must
+	       ;; check to see if the next character (if there is one)
+	       ;; is an astrisk or a plus or a question mark.  If so then we must not use this
+	       ;; character in the big literal.
+	       (progn 
+		 (if (or (eql term #\*)
+                         (eql term #\+)
+                         (eql term #\?))
+		     (setf lit (subseq lit 0 (1- (length lit)))))
+		 (add-exp `((if (< length (+ index ,(length lit)))
+				(return-from compare nil))
+			    (if (not (string= string ,lit :start1 index
+					      :end1 (+ index ,(length lit))))
+				(return-from compare nil)
+			      (incf index ,(length lit)))))))
+	     (incf eindex (1- (length lit))))))))
+    ;;
+    ;; Plug end of list to return t.  If we made it this far then
+    ;; We have matched!
+    (add-exp '((setf (cadr (aref *regex-groups* 0))
+		     index)))
+    (add-exp '((return-from final-return t)))
+    ;;
+;;;    (print expression)
+    ;;
+    ;; Now take the expression list and turn it into a lambda expression
+    ;; replacing the special flags with lisp code.
+    ;; For example:  A BEGIN needs to be replace by an expression that
+    ;; saves the current index, then evaluates everything till it gets to
+    ;; the END then save the new index if it didn't fail.
+    ;; On an ASTRISK I need to take the previous expression and wrap
+    ;; it in a do that will evaluate the expression till an error
+    ;; occurs and then another do that encompases the remainder of the
+    ;; regular expression and iterates decrementing the index by one
+    ;; of the matched expression sizes and then returns nil.  After
+    ;; the last expression insert a form that does a return t so that
+    ;; if the entire nested sub-expression succeeds then the loop
+    ;; is broken manually.
+    ;; 
+    (setf result (copy-tree nil))
+    ;;
+    ;; Reversing the current expression makes building up the 
+    ;; lambda list easier due to the nexting of expressions when 
+    ;; and astrisk has been encountered.
+    (setf expression (reverse expression))
+    (do ((elt 0 (1+ elt)))
+	((>= elt (length expression)))
+      (let ((piece (nth elt expression)))
+	;;
+	;; Now check for PLUS, if so then ditto the expression and then let the
+	;; ASTRISK below handle the rest.
+	;;
+	(cond ((eql piece 'PLUS)
+	       (cond ((listp (nth (1+ elt) expression))
+		      (setf result (append (list (nth (1+ elt) expression))
+					   result)))
+		     ;;
+		     ;; duplicate the entire group
+		     ;; NOTE: This hasn't been implemented yet!!
+		     (t
+		      (error "GROUP repeat hasn't been implemented yet~%")))))
+	(cond ((listp piece)		;Just append the list
+	       (setf result (append (list piece) result)))
+	      ((eql piece 'QUESTION)	; Wrap it in a block that won't fail
+	       (cond ((listp (nth (1+ elt) expression))
+		      (setf result 
+			    (append `((progn (block compare
+						    ,(nth (1+ elt) 
+							  expression))
+					     t))
+				    result))
+		      (incf elt))
+		     ;;
+		     ;; This is a QUESTION on an entire group which
+		     ;; hasn't been implemented yet!!!
+		     ;;
+		     (t
+		      (error "Optional groups not implemented yet~%"))))
+	      ((or (eql piece 'ASTRISK) ; Do the wild thing!
+		   (eql piece 'PLUS))
+	       (cond ((listp (nth (1+ elt) expression))
+		      ;;
+		      ;; This is a single character wild card so
+		      ;; do the simple form.
+		      ;;
+		      (setf result 
+			    `((let ((oindex index))
+				(block compare
+				       (do ()
+					   (nil)
+					 ,(nth (1+ elt) expression)))
+				(do ((start index (1- start)))
+				    ((< start oindex) nil)
+				  (let ((index start))
+				    (block compare
+					   , at result))))))
+		      (incf elt))
+		     (t
+		      ;;
+		      ;; This is a subgroup repeated so I must build
+		      ;; the loop using several values.
+		      ;;
+		      ))
+	       )
+	      (t t))))			; Just ignore everything else.
+    ;;
+    ;; Now wrap the result in a lambda list that can then be 
+    ;; invoked or compiled, however the user wishes.
+    ;;
+    (if anchored
+	(setf result
+	      `(lambda (string &key (start 0) (end (length string)))
+		 (setf *regex-groupings* ,group)
+		 (block final-return
+			(block compare
+			       (let ((index start)
+				     (length end))
+				 , at result)))))
+      (setf result
+	    `(lambda (string &key (start 0) (end (length string)))
+	       (setf *regex-groupings* ,group)
+	       (block final-return
+		      (let ((length end))
+			, at fast-first
+			(do ((marker start (1+ marker)))
+			    ((> marker end) nil)
+			  (let ((index marker))
+			    (if (block compare
+				       , at result)
+				(return t)))))))))))
+
+;; (provide 'nregex)

Added: branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/sbcl-pprint-patch.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,332 @@
+;; Pretty printer patch for SBCL, which adds the "annotations" feature
+;; required for sending presentations through pretty-printing streams.
+;;
+;; The section marked "Changed functions" and the DEFSTRUCT
+;; PRETTY-STREAM are based on SBCL's pprint.lisp.
+;; 
+;; Public domain.
+
+(in-package "SB!PRETTY")
+
+(defstruct (annotation (:include queued-op))
+  (handler (constantly nil) :type function)
+  (record))
+
+
+(defstruct (pretty-stream (:include sb!kernel:ansi-stream
+				    (out #'pretty-out)
+				    (sout #'pretty-sout)
+				    (misc #'pretty-misc))
+			  (:constructor make-pretty-stream (target))
+			  (:copier nil))
+  ;; Where the output is going to finally go.
+  (target (missing-arg) :type stream)
+  ;; Line length we should format to. Cached here so we don't have to keep
+  ;; extracting it from the target stream.
+  (line-length (or *print-right-margin*
+		   (sb!impl::line-length target)
+		   default-line-length)
+	       :type column)
+  ;; A simple string holding all the text that has been output but not yet
+  ;; printed.
+  (buffer (make-string initial-buffer-size) :type (simple-array character (*)))
+  ;; The index into BUFFER where more text should be put.
+  (buffer-fill-pointer 0 :type index)
+  ;; Whenever we output stuff from the buffer, we shift the remaining noise
+  ;; over. This makes it difficult to keep references to locations in
+  ;; the buffer. Therefore, we have to keep track of the total amount of
+  ;; stuff that has been shifted out of the buffer.
+  (buffer-offset 0 :type posn)
+  ;; The column the first character in the buffer will appear in. Normally
+  ;; zero, but if we end up with a very long line with no breaks in it we
+  ;; might have to output part of it. Then this will no longer be zero.
+  (buffer-start-column (or (sb!impl::charpos target) 0) :type column)
+  ;; The line number we are currently on. Used for *PRINT-LINES*
+  ;; abbreviations and to tell when sections have been split across
+  ;; multiple lines.
+  (line-number 0 :type index)
+  ;; the value of *PRINT-LINES* captured at object creation time. We
+  ;; use this, instead of the dynamic *PRINT-LINES*, to avoid
+  ;; weirdness like
+  ;;   (let ((*print-lines* 50))
+  ;;     (pprint-logical-block ..
+  ;;       (dotimes (i 10)
+  ;;         (let ((*print-lines* 8))
+  ;;           (print (aref possiblybigthings i) prettystream)))))
+  ;; terminating the output of the entire logical blockafter 8 lines.
+  (print-lines *print-lines* :type (or index null) :read-only t)
+  ;; Stack of logical blocks in effect at the buffer start.
+  (blocks (list (make-logical-block)) :type list)
+  ;; Buffer holding the per-line prefix active at the buffer start.
+  ;; Indentation is included in this. The length of this is stored
+  ;; in the logical block stack.
+  (prefix (make-string initial-buffer-size) :type (simple-array character (*)))
+  ;; Buffer holding the total remaining suffix active at the buffer start.
+  ;; The characters are right-justified in the buffer to make it easier
+  ;; to output the buffer. The length is stored in the logical block
+  ;; stack.
+  (suffix (make-string initial-buffer-size) :type (simple-array character (*)))
+  ;; Queue of pending operations. When empty, HEAD=TAIL=NIL. Otherwise,
+  ;; TAIL holds the first (oldest) cons and HEAD holds the last (newest)
+  ;; cons. Adding things to the queue is basically (setf (cdr head) (list
+  ;; new)) and removing them is basically (pop tail) [except that care must
+  ;; be taken to handle the empty queue case correctly.]
+  (queue-tail nil :type list)
+  (queue-head nil :type list)
+  ;; Block-start queue entries in effect at the queue head.
+  (pending-blocks nil :type list)
+  ;; Queue of annotations to the buffer
+  (annotations-tail nil :type list)
+  (annotations-head nil :type list))
+
+
+(defmacro enqueue (stream type &rest args)
+  (let ((constructor (intern (concatenate 'string
+					  "MAKE-"
+					  (symbol-name type))
+			     "SB-PRETTY")))
+    (once-only ((stream stream)
+		(entry `(,constructor :posn
+				      (index-posn
+				       (pretty-stream-buffer-fill-pointer
+					,stream)
+				       ,stream)
+				      , at args))
+		(op `(list ,entry))
+		(head `(pretty-stream-queue-head ,stream)))
+      `(progn
+	 (if ,head
+	     (setf (cdr ,head) ,op)
+	     (setf (pretty-stream-queue-tail ,stream) ,op))
+	 (setf (pretty-stream-queue-head ,stream) ,op)
+	 ,entry))))
+
+;;;
+;;; New helper functions
+;;;
+
+(defun enqueue-annotation (stream handler record)
+  (enqueue stream annotation :handler handler
+	   :record record))
+
+(defun re-enqueue-annotation (stream annotation)
+  (let* ((annotation-cons (list annotation))
+	 (head (pretty-stream-annotations-head stream)))
+    (if head
+	(setf (cdr head) annotation-cons)
+	(setf (pretty-stream-annotations-tail stream) annotation-cons))
+    (setf (pretty-stream-annotations-head stream) annotation-cons)
+    nil))
+
+(defun re-enqueue-annotations (stream end)
+  (loop for tail = (pretty-stream-queue-tail stream) then (cdr tail)
+     while (and tail (not (eql (car tail) end)))
+     when (annotation-p (car tail)) 
+     do (re-enqueue-annotation stream (car tail))))
+
+(defun dequeue-annotation (stream &key end-posn)
+  (let ((next-annotation (car (pretty-stream-annotations-tail stream))))
+    (when next-annotation
+      (when (or (not end-posn)
+		(<= (annotation-posn next-annotation) end-posn))
+	(pop (pretty-stream-annotations-tail stream))
+	(unless (pretty-stream-annotations-tail stream)
+	  (setf (pretty-stream-annotations-head stream) nil))
+	next-annotation))))
+
+(defun invoke-annotation (stream annotation truncatep)
+  (let ((target (pretty-stream-target stream)))
+    (funcall (annotation-handler annotation)
+	     (annotation-record annotation)
+	     target
+	     truncatep)))
+
+(defun output-buffer-with-annotations (stream end)
+  (let ((target (pretty-stream-target stream))
+	(buffer (pretty-stream-buffer stream))
+	(end-posn (index-posn end stream))
+	(start 0))
+    (loop
+       for annotation = (dequeue-annotation stream :end-posn end-posn)
+       while annotation
+       do
+	 (let ((annotation-index (posn-index (annotation-posn annotation)
+					     stream)))
+	   (when (> annotation-index start)
+	     (write-string buffer target :start start 
+			   :end annotation-index)
+	     (setf start annotation-index))
+	   (invoke-annotation stream annotation nil)))
+    (when (> end start)
+      (write-string buffer target :start start :end end))))
+
+(defun flush-annotations (stream end truncatep)
+  (let ((end-posn (index-posn end stream)))
+    (loop
+       for annotation = (dequeue-annotation stream :end-posn end-posn)
+       while annotation
+       do (invoke-annotation stream annotation truncatep))))
+
+;;;
+;;; Changed functions
+;;;
+
+(defun maybe-output (stream force-newlines-p)
+  (declare (type pretty-stream stream))
+  (let ((tail (pretty-stream-queue-tail stream))
+	(output-anything nil))
+    (loop
+      (unless tail
+	(setf (pretty-stream-queue-head stream) nil)
+	(return))
+      (let ((next (pop tail)))
+	(etypecase next
+	  (newline
+	   (when (ecase (newline-kind next)
+		   ((:literal :mandatory :linear) t)
+		   (:miser (misering-p stream))
+		   (:fill
+		    (or (misering-p stream)
+			(> (pretty-stream-line-number stream)
+			   (logical-block-section-start-line
+			    (first (pretty-stream-blocks stream))))
+			(ecase (fits-on-line-p stream
+					       (newline-section-end next)
+					       force-newlines-p)
+			  ((t) nil)
+			  ((nil) t)
+			  (:dont-know
+			   (return))))))
+	     (setf output-anything t)
+	     (output-line stream next)))
+	  (indentation
+	   (unless (misering-p stream)
+	     (set-indentation stream
+			      (+ (ecase (indentation-kind next)
+				   (:block
+				    (logical-block-start-column
+				     (car (pretty-stream-blocks stream))))
+				   (:current
+				    (posn-column
+				     (indentation-posn next)
+				     stream)))
+				 (indentation-amount next)))))
+	  (block-start
+	   (ecase (fits-on-line-p stream (block-start-section-end next)
+				  force-newlines-p)
+	     ((t)
+	      ;; Just nuke the whole logical block and make it look like one
+	      ;; nice long literal.  (But don't nuke annotations.)
+	      (let ((end (block-start-block-end next)))
+		(expand-tabs stream end)
+		(re-enqueue-annotations stream end)
+		(setf tail (cdr (member end tail)))))
+	     ((nil)
+	      (really-start-logical-block
+	       stream
+	       (posn-column (block-start-posn next) stream)
+	       (block-start-prefix next)
+	       (block-start-suffix next)))
+	     (:dont-know
+	      (return))))
+	  (block-end
+	   (really-end-logical-block stream))
+	  (tab
+	   (expand-tabs stream next))
+	  (annotation
+	   (re-enqueue-annotation stream next))))
+      (setf (pretty-stream-queue-tail stream) tail))
+    output-anything))
+
+(defun output-line (stream until)
+  (declare (type pretty-stream stream)
+	   (type newline until))
+  (let* ((target (pretty-stream-target stream))
+	 (buffer (pretty-stream-buffer stream))
+	 (kind (newline-kind until))
+	 (literal-p (eq kind :literal))
+	 (amount-to-consume (posn-index (newline-posn until) stream))
+	 (amount-to-print
+	  (if literal-p
+	      amount-to-consume
+	      (let ((last-non-blank
+		     (position #\space buffer :end amount-to-consume
+			       :from-end t :test #'char/=)))
+		(if last-non-blank
+		    (1+ last-non-blank)
+		    0)))))
+    (output-buffer-with-annotations stream amount-to-print)
+    (flush-annotations stream amount-to-consume nil)
+    (let ((line-number (pretty-stream-line-number stream)))
+      (incf line-number)
+      (when (and (not *print-readably*)
+		 (pretty-stream-print-lines stream)
+		 (>= line-number (pretty-stream-print-lines stream)))
+	(write-string " .." target)
+	(flush-annotations stream 
+			   (pretty-stream-buffer-fill-pointer stream)
+			   t)
+	(let ((suffix-length (logical-block-suffix-length
+			      (car (pretty-stream-blocks stream)))))
+	  (unless (zerop suffix-length)
+	    (let* ((suffix (pretty-stream-suffix stream))
+		   (len (length suffix)))
+	      (write-string suffix target
+			    :start (- len suffix-length)
+			    :end len))))
+	(throw 'line-limit-abbreviation-happened t))
+      (setf (pretty-stream-line-number stream) line-number)
+      (write-char #\newline target)
+      (setf (pretty-stream-buffer-start-column stream) 0)
+      (let* ((fill-ptr (pretty-stream-buffer-fill-pointer stream))
+	     (block (first (pretty-stream-blocks stream)))
+	     (prefix-len
+	      (if literal-p
+		  (logical-block-per-line-prefix-end block)
+		  (logical-block-prefix-length block)))
+	     (shift (- amount-to-consume prefix-len))
+	     (new-fill-ptr (- fill-ptr shift))
+	     (new-buffer buffer)
+	     (buffer-length (length buffer)))
+	(when (> new-fill-ptr buffer-length)
+	  (setf new-buffer
+		(make-string (max (* buffer-length 2)
+				  (+ buffer-length
+				     (floor (* (- new-fill-ptr buffer-length)
+					       5)
+					    4)))))
+	  (setf (pretty-stream-buffer stream) new-buffer))
+	(replace new-buffer buffer
+		 :start1 prefix-len :start2 amount-to-consume :end2 fill-ptr)
+	(replace new-buffer (pretty-stream-prefix stream)
+		 :end1 prefix-len)
+	(setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr)
+	(incf (pretty-stream-buffer-offset stream) shift)
+	(unless literal-p
+	  (setf (logical-block-section-column block) prefix-len)
+	  (setf (logical-block-section-start-line block) line-number))))))
+
+(defun output-partial-line (stream)
+  (let* ((fill-ptr (pretty-stream-buffer-fill-pointer stream))
+	 (tail (pretty-stream-queue-tail stream))
+	 (count
+	  (if tail
+	      (posn-index (queued-op-posn (car tail)) stream)
+	      fill-ptr))
+	 (new-fill-ptr (- fill-ptr count))
+	 (buffer (pretty-stream-buffer stream)))
+    (when (zerop count)
+      (error "Output-partial-line called when nothing can be output."))
+    (output-buffer-with-annotations stream count)
+    (incf (pretty-stream-buffer-start-column stream) count)
+    (replace buffer buffer :end1 new-fill-ptr :start2 count :end2 fill-ptr)
+    (setf (pretty-stream-buffer-fill-pointer stream) new-fill-ptr)
+    (incf (pretty-stream-buffer-offset stream) count)))
+
+(defun force-pretty-output (stream)
+  (maybe-output stream nil)
+  (expand-tabs stream nil)
+  (re-enqueue-annotations stream nil)
+  (output-buffer-with-annotations stream 
+				  (pretty-stream-buffer-fill-pointer stream)))
+	      
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/slime-autoloads.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/slime-autoloads.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/slime-autoloads.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,50 @@
+;;; slime-autoloads.el --- autoload definitions for SLIME
+
+;; Copyright (C) 2007  Helmut Eller
+
+;; This file is protected by the GNU GPLv2 (or later), as distributed
+;; with GNU Emacs.
+
+;;; Commentary:
+
+;; This code defines the necessary autoloads, so that we don't need to
+;; load everything from .emacs.
+
+;;; Code:
+
+(autoload 'slime "slime"
+  "Start a Lisp subprocess and connect to its Swank server." t) 
+
+(autoload 'slime-mode "slime"
+  "SLIME: The Superior Lisp Interaction (Minor) Mode for Emacs." t)
+
+(autoload 'slime-connect "slime"
+  "Connect to a running Swank server." t)
+
+(autoload 'hyperspec-lookup "hyperspec" nil t)
+
+(autoload 'slime-lisp-mode-hook "slime")
+(autoload 'slime-scheme-mode-hook "slime")
+
+(defvar slime-lisp-modes '(lisp-mode))
+
+(defun slime-setup (&optional contribs)
+  "Setup Emacs so that lisp-mode buffers always use SLIME.
+CONTRIBS is a list of contrib packages to load."
+  (when (member 'lisp-mode slime-lisp-modes)
+    (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
+  (setq slime-setup-contribs contribs)
+  (add-hook 'slime-load-hook 'slime-setup-contribs))
+
+(defvar slime-setup-contribs nil)
+
+(defun slime-setup-contribs () 
+  (dolist (c slime-setup-contribs)
+    (require c)
+    (let ((init (intern (format "%s-init" c))))
+      (when (fboundp init)
+        (funcall init)))))
+
+(provide 'slime-autoloads)
+
+;;; slime-autoloads.el ends here

Added: branches/trunk-reorg/thirdparty/slime/slime.el
===================================================================
--- branches/trunk-reorg/thirdparty/slime/slime.el	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/slime.el	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,9543 @@
+;;; slime.el --- Superior Lisp Interaction Mode for Emacs
+;;
+;;;; License
+;;     Copyright (C) 2003  Eric Marsden, Luke Gorrie, Helmut Eller
+;;     Copyright (C) 2004,2005,2006  Luke Gorrie, Helmut Eller
+;;
+;;     This program is free software; you can redistribute it and/or
+;;     modify it under the terms of the GNU General Public License as
+;;     published by the Free Software Foundation; either version 2 of
+;;     the License, or (at your option) any later version.
+;;
+;;     This program is distributed in the hope that it will be useful,
+;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;     GNU General Public License for more details.
+;;
+;;     You should have received a copy of the GNU General Public
+;;     License along with this program; if not, write to the Free
+;;     Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;;     MA 02111-1307, USA.
+
+
+;;;; Commentary
+;;
+;; This file contains extensions for programming in Common Lisp. The
+;; main features are:
+;;
+;;   A socket-based communication/RPC interface between Emacs and
+;;   Lisp.
+;;
+;;   The `slime-mode' minor-mode complementing `lisp-mode'. This new
+;;   mode includes many commands for interacting with the Common Lisp
+;;   process.
+;;
+;;   Common Lisp REPL (Read-Eval-Print Loop) written in Emacs Lisp,
+;;   similar to `ielm'.
+;;
+;;   Common Lisp debugger written in Emacs Lisp. The debugger pops up
+;;   an Emacs buffer similar to the Emacs/Elisp debugger.
+;;
+;;   Trapping compiler messages and creating annotations in the source
+;;   file on the appropriate forms.
+;;
+;; SLIME is compatible with GNU Emacs 20 and 21 and XEmacs 21. In
+;; order to run SLIME requires a supporting Lisp server called
+;; Swank. Swank is distributed with slime.el and will automatically be
+;; started in a normal installation.
+
+
+;;;; Dependencies and setup
+
+(eval-and-compile
+  (require 'cl)
+  (unless (fboundp 'define-minor-mode)
+    (require 'easy-mmode)
+    (defalias 'define-minor-mode 'easy-mmode-define-minor-mode)))
+(require 'comint)
+(require 'timer)
+(require 'pp)
+(require 'hideshow)
+(require 'hyperspec)
+(require 'font-lock)
+(when (featurep 'xemacs)
+  (require 'overlay))
+(require 'easymenu)
+
+(defvar slime-lisp-modes '(lisp-mode))
+
+(defun slime-setup (&optional contribs)
+  "Setup Emacs so that lisp-mode buffers always use SLIME.
+CONTRIBS is a list of contrib packages to load."
+  (when (member 'lisp-mode slime-lisp-modes)
+    (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook))
+  (dolist (c contribs)
+    (require c)
+    (let ((init (intern (format "%s-init" c))))
+      (when (fboundp init)
+        (funcall init)))))
+
+(defun slime-lisp-mode-hook ()
+  (slime-mode 1)
+  (set (make-local-variable 'lisp-indent-function)
+       'common-lisp-indent-function))
+
+(eval-and-compile 
+  (defvar slime-path
+    (let ((path (or (locate-library "slime") load-file-name)))
+      (and path (file-name-directory path)))
+    "Directory containing the Slime package.
+This is used to load the supporting Common Lisp library, Swank.
+The default value is automatically computed from the location of the
+Emacs Lisp package."))
+
+(eval-and-compile
+  (defun slime-changelog-date ()
+    "Return the datestring of the latest entry in the ChangeLog file.
+Return nil if the ChangeLog file cannot be found."
+    (let ((changelog (concat slime-path "ChangeLog")))
+      (if (file-exists-p changelog)
+          (with-temp-buffer 
+            (insert-file-contents changelog nil 0 100)
+            (goto-char (point-min))
+            (symbol-name (read (current-buffer))))
+        nil))))
+
+(defvar slime-protocol-version nil)
+(setq slime-protocol-version
+      (eval-when-compile (slime-changelog-date)))
+
+
+;;;; Customize groups
+;;
+;;;;; slime
+
+(defgroup slime nil
+  "Interaction with the Superior Lisp Environment."
+  :prefix "slime-"
+  :group 'applications)
+
+;;;;; slime-ui
+
+(defgroup slime-ui nil
+  "Interaction with the Superior Lisp Environment."
+  :prefix "slime-"
+  :group 'slime)
+
+(defcustom slime-truncate-lines t
+  "Set `truncate-lines' in popup buffers.
+This applies to buffers that present lines as rows of data, such as
+debugger backtraces and apropos listings."
+  :type 'boolean
+  :group 'slime-ui)
+
+(defcustom slime-update-modeline-package t
+  "Automatically update the Lisp package name in the minibuffer.
+This is done with a text-search that runs on an idle timer."
+  :type 'boolean
+  :group 'slime-ui)
+
+(defcustom slime-kill-without-query-p nil
+  "If non-nil, kill SLIME processes without query when quitting Emacs.
+This applies to the *inferior-lisp* buffer and the network connections."
+  :type 'boolean
+  :group 'slime-ui)
+
+;;;;; slime-lisp
+
+(defgroup slime-lisp nil
+  "Lisp server configuration."
+  :prefix "slime-"
+  :group 'slime)
+
+(defcustom slime-backend "swank-loader.lisp"
+  "The name of the Lisp file that loads the Swank server.
+This name is interpreted relative to the directory containing
+slime.el, but could also be set to an absolute filename."
+  :type 'string
+  :group 'slime-lisp)
+
+(defcustom slime-connected-hook nil
+  "List of functions to call when SLIME connects to Lisp."
+  :type 'hook
+  :group 'slime-lisp)
+
+(defcustom slime-filename-translations nil
+  "Assoc list of hostnames and filename translation functions.  
+Each element is of the form (HOSTNAME-REGEXP TO-LISP FROM-LISP).
+
+HOSTNAME-REGEXP is a regexp which is applied to the connection's
+slime-machine-instance. If HOSTNAME-REGEXP maches then the
+corresponding TO-LISP and FROM-LISP functions will be used to
+translate emacs filenames and lisp filenames.
+
+TO-LISP will be passed the filename of an emacs buffer and must
+return a string which the underlying lisp understandas as a
+pathname. FROM-LISP will be passed a pathname as returned by the
+underlying lisp and must return something that emacs will
+understand as a filename (this string will be passed to
+find-file).
+
+This list will be traversed in order, so multiple matching
+regexps are possible.
+
+Example:
+
+Assuming you run emacs locally and connect to slime running on
+the machine 'soren' and you can connect with the username
+'animaliter':
+
+  (push (list \"^soren$\"
+              (lambda (emacs-filename)
+                (subseq emacs-filename (length \"/ssh:animaliter at soren:\")))
+              (lambda (lisp-filename)
+                (concat \"/ssh:animaliter at soren:\" lisp-filename)))
+        slime-filename-translations)
+
+See also `slime-create-filename-translator'."
+  :type '(repeat (list :tag "Host description"
+                       (regexp :tag "Hostname regexp")
+                       (function :tag "To   lisp function")
+                       (function :tag "From lisp function")))
+  :group 'slime-lisp)
+
+(defcustom slime-enable-evaluate-in-emacs nil
+  "*If non-nil, the inferior Lisp can evaluate arbitrary forms in Emacs.
+The default is nil, as this feature can be a security risk."
+  :type '(boolean)
+  :group 'slime-lisp)
+
+;;;;; slime-mode
+
+(defgroup slime-mode nil
+  "Settings for slime-mode Lisp source buffers."
+  :prefix "slime-"
+  :group 'slime)
+
+(defcustom slime-edit-definition-fallback-function nil
+  "Function to call when edit-definition fails to find the source itself.
+The function is called with the definition name, a string, as its argument.
+
+If you want to fallback on TAGS you can set this to `find-tag',
+`slime-find-tag-if-tags-table-visited', or
+`slime-edit-definition-with-etags'."
+  :type 'symbol
+  :group 'slime-mode-mode
+  :options '(nil 
+             slime-edit-definition-with-etags
+             slime-find-tag-if-tags-table-visited
+             find-tag))
+
+(defcustom slime-complete-symbol-function 'slime-simple-complete-symbol
+  "*Function to perform symbol completion."
+  :group 'slime-mode
+  :type '(choice (const :tag "Simple" slime-simple-complete-symbol)
+                 (const :tag "Compound" slime-complete-symbol*)
+                 (const :tag "Fuzzy" slime-fuzzy-complete-symbol)))
+
+(defcustom slime-when-complete-filename-expand nil
+  "Use comint-replace-by-expanded-filename instead of comint-dynamic-complete-as-filename to complete file names"
+  :group 'slime-mode
+  :type 'boolean)
+
+(defcustom slime-space-information-p t
+  "Have the SPC key offer arglist information."
+  :type 'boolean
+  :group 'slime-mode)
+
+;;;;; slime-mode-faces
+
+(defgroup slime-mode-faces nil
+  "Faces in slime-mode source code buffers."
+  :prefix "slime-"
+  :group 'slime-mode)
+
+(defun slime-underline-color (color)
+  "Return a legal value for the :underline face attribute based on COLOR."
+  ;; In XEmacs the :underline attribute can only be a boolean.
+  ;; In GNU it can be the name of a colour.
+  (if (featurep 'xemacs)
+      (if color t nil)
+    color))
+
+(defface slime-error-face
+  `((((class color) (background light))
+     (:underline ,(slime-underline-color "red")))
+    (((class color) (background dark))
+     (:underline ,(slime-underline-color "red")))
+    (t (:underline t)))
+  "Face for errors from the compiler."
+  :group 'slime-mode-faces)
+
+(defface slime-warning-face
+  `((((class color) (background light))
+     (:underline ,(slime-underline-color "orange")))
+    (((class color) (background dark))
+     (:underline ,(slime-underline-color "coral")))
+    (t (:underline t)))
+  "Face for warnings from the compiler."
+  :group 'slime-mode-faces)
+
+(defface slime-style-warning-face
+  `((((class color) (background light))
+     (:underline ,(slime-underline-color "brown")))
+    (((class color) (background dark))
+     (:underline ,(slime-underline-color "gold")))
+    (t (:underline t)))
+  "Face for style-warnings from the compiler."
+  :group 'slime-mode-faces)
+
+(defface slime-note-face
+  `((((class color) (background light))
+     (:underline ,(slime-underline-color "brown4")))
+    (((class color) (background dark))
+     (:underline ,(slime-underline-color "light goldenrod")))
+    (t (:underline t)))
+  "Face for notes from the compiler."
+  :group 'slime-mode-faces)
+
+(defun slime-face-inheritance-possible-p ()
+  "Return true if the :inherit face attribute is supported." 
+  (assq :inherit custom-face-attributes))
+
+(defface slime-highlight-face
+  (if (slime-face-inheritance-possible-p)
+      '((t (:inherit highlight :underline nil)))
+    '((((class color) (background light))
+       (:background "darkseagreen2"))
+      (((class color) (background dark))
+       (:background "darkolivegreen"))
+      (t (:inverse-video t))))
+  "Face for compiler notes while selected."
+  :group 'slime-mode-faces)
+
+;;;;; sldb
+
+(defgroup slime-debugger nil
+  "Backtrace options and fontification."
+  :prefix "sldb-"
+  :group 'slime)
+
+(defmacro define-sldb-faces (&rest faces)
+  "Define the set of SLDB faces.
+Each face specifiation is (NAME DESCRIPTION &optional PROPERTIES).
+NAME is a symbol; the face will be called sldb-NAME-face.
+DESCRIPTION is a one-liner for the customization buffer.
+PROPERTIES specifies any default face properties."
+  `(progn ,@(loop for face in faces
+                  collect `(define-sldb-face , at face))))
+
+(defmacro define-sldb-face (name description &optional default)
+  (let ((facename (intern (format "sldb-%s-face" (symbol-name name)))))
+    `(defface ,facename
+       (list (list t ,default))
+      ,(format "Face for %s." description)
+      :group 'slime-debugger)))
+
+(define-sldb-faces
+  (topline        "the top line describing the error")
+  (condition      "the condition class")
+  (section        "the labels of major sections in the debugger buffer")
+  (frame-label    "backtrace frame numbers")
+  (restart-type   "restart names."
+                  (if (slime-face-inheritance-possible-p)
+                      '(:inherit font-lock-keyword-face)))
+  (restart        "restart descriptions")
+  (restart-number "restart numbers (correspond to keystrokes to invoke)"
+                  '(:bold t))
+  (frame-line     "function names and arguments in the backtrace")
+  (detailed-frame-line
+   "function names and arguments in a detailed (expanded) frame")
+  (local-name     "local variable names")
+  (local-value    "local variable values")
+  (catch-tag      "catch tags"))
+
+;;;;; slime-repl
+
+(defgroup slime-repl nil
+  "The Read-Eval-Print Loop (*slime-repl* buffer)."
+  :prefix "slime-repl-"
+  :group 'slime)
+
+(defcustom slime-repl-shortcut-dispatch-char ?\,
+  "Character used to distinguish repl commands from lisp forms."
+  :type '(character)
+  :group 'slime-repl)
+
+(defcustom slime-repl-only-save-lisp-buffers t
+  "When T we only attempt to save lisp-mode file buffers. When
+  NIL slime will attempt to save all buffers (as per
+  save-some-buffers). This applies to all ASDF related repl
+  shortcuts."
+  :type '(boolean)
+  :group 'slime-repl)
+
+(defcustom slime-repl-return-behaviour :send-if-complete
+  "Keyword specifying how slime-repl-return behaves when the
+  point is on a lisp expression (as opposed to being on a
+  previous output).
+
+Currently only two values are supported:
+
+:send-if-complete - If the current expression is complete, as per
+slime-input-complete-p, it is sent to the underlying lisp,
+otherwise a newline is inserted. The current value of (point) has
+no effect.
+
+:send-only-if-after-complete - If the current expression is complete
+and point is after the expression it is sent, otherwise a newline
+is inserted."
+  :type '(choice (const :tag "Send if complete" :value :send-if-complete)
+                 (const :tag "Send only if after complete" :value :send-only-if-after-complete))
+  :group 'slime-repl)
+  
+
+(defface slime-repl-prompt-face
+  (if (slime-face-inheritance-possible-p)
+      '((t (:inherit font-lock-keyword-face)))
+    '((((class color) (background light)) (:foreground "Purple"))
+      (((class color) (background dark)) (:foreground "Cyan"))
+      (t (:weight bold))))
+  "Face for the prompt in the SLIME REPL."
+  :group 'slime-repl)
+
+(defface slime-repl-output-face
+  (if (slime-face-inheritance-possible-p)
+      '((t (:inherit font-lock-string-face)))
+    '((((class color) (background light)) (:foreground "RosyBrown"))
+      (((class color) (background dark)) (:foreground "LightSalmon"))
+      (t (:slant italic))))
+  "Face for Lisp output in the SLIME REPL."
+  :group 'slime-repl)
+
+(defface slime-repl-input-face
+  '((t (:bold t)))
+  "Face for previous input in the SLIME REPL."
+  :group 'slime-repl)
+
+(defface slime-repl-result-face
+  '((t ()))
+  "Face for the result of an evaluation in the SLIME REPL."
+  :group 'slime-repl)
+
+(defcustom slime-repl-history-file "~/.slime-history.eld"
+  "File to save the persistent REPL history to."
+  :type 'string
+  :group 'slime-repl)
+
+(defcustom slime-repl-history-size 200
+  "*Maximum number of lines for persistent REPL history."
+  :type 'integer
+  :group 'slime-repl)
+
+
+;;;; Minor modes
+
+;;;;; slime-mode
+
+(define-minor-mode slime-mode
+  "\\<slime-mode-map>\
+SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).
+
+Commands to compile the current buffer's source file and visually
+highlight any resulting compiler notes and warnings:
+\\[slime-compile-and-load-file]	- Compile and load the current buffer's file.
+\\[slime-compile-file]	- Compile (but not load) the current buffer's file.
+\\[slime-compile-defun]	- Compile the top-level form at point.
+
+Commands for visiting compiler notes:
+\\[slime-next-note]	- Goto the next form with a compiler note.
+\\[slime-previous-note]	- Goto the previous form with a compiler note.
+\\[slime-remove-notes]	- Remove compiler-note annotations in buffer.
+
+Finding definitions:
+\\[slime-edit-definition]	- Edit the definition of the function called at point.
+\\[slime-pop-find-definition-stack]	- Pop the definition stack to go back from a definition.
+
+Documentation commands:
+\\[slime-describe-symbol]	- Describe symbol.
+\\[slime-apropos]	- Apropos search.
+\\[slime-disassemble-symbol]	- Disassemble a function.
+
+Evaluation commands:
+\\[slime-eval-defun]	- Evaluate top-level from containing point.
+\\[slime-eval-last-expression]	- Evaluate sexp before point.
+\\[slime-pprint-eval-last-expression]	- Evaluate sexp before point, pretty-print result.
+
+Full set of commands:
+\\{slime-mode-map}"
+  nil
+  nil
+  ;; Fake binding to coax `define-minor-mode' to create the keymap
+  '((" " 'undefined)))
+
+(make-variable-buffer-local
+ (defvar slime-modeline-package nil
+   "The Lisp package to show in the modeline.
+This is automatically updated based on the buffer/point."))
+
+(defun slime-update-modeline-package ()
+  (ignore-errors
+    (when (and slime-update-modeline-package
+               (memq major-mode slime-lisp-modes)
+               slime-mode)
+      (let ((package (slime-current-package)))
+        (when package
+          (setq slime-modeline-package
+                (slime-pretty-package-name package)))))))
+
+(defun slime-pretty-package-name (name)
+  "Return a pretty version of a package name NAME."
+  (let ((name (cond ((string-match "^:\\(.*\\)$" name)    
+                     (match-string 1 name))
+                    ((string-match "^\"\\(.*\\)\"$" name) 
+                     (match-string 1 name))
+                    (t name))))
+    (format "%s" (read name))))
+
+(when slime-update-modeline-package
+  (run-with-idle-timer 0.2 0.2 'slime-update-modeline-package))
+
+;; Setup the mode-line to say when we're in slime-mode, and which CL
+;; package we think the current buffer belongs to.
+(add-to-list 'minor-mode-alist
+             '(slime-mode
+               (" Slime"
+		((slime-modeline-package (":" slime-modeline-package) "")
+		 slime-state-name))))
+
+(defun slime-input-complete-p (start end)
+  "Return t if the region from START to END contains a complete sexp."
+  (save-excursion
+    (goto-char start)
+    (cond ((looking-at "\\s *['`#]?[(\"]")
+           (ignore-errors
+             (save-restriction
+               (narrow-to-region start end)
+               ;; Keep stepping over blanks and sexps until the end of
+               ;; buffer is reached or an error occurs. Tolerate extra
+               ;; close parens.
+               (loop do (skip-chars-forward " \t\r\n)")
+                     until (eobp)
+                     do (forward-sexp))
+               t)))
+          (t t))))
+
+
+;;;;; Key bindings
+
+;; See `slime-define-key' below for keyword meanings.
+(defvar slime-keys
+  '(;; Compiler notes
+    ("\M-p" slime-previous-note)
+    ("\M-n" slime-next-note)
+    ("\M-c" slime-remove-notes :prefixed t)
+    ("\C-k" slime-compile-and-load-file :prefixed t)
+    ("\M-k" slime-compile-file :prefixed t)
+    ("\C-c" slime-compile-defun :prefixed t)
+    ("\C-l" slime-load-file :prefixed t)
+    ;; Editing/navigating
+    ("\M-\C-i" slime-complete-symbol :inferior t)
+    ("\C-i" slime-complete-symbol :prefixed t :inferior t)
+    ("\M-." slime-edit-definition :inferior t :sldb t)
+    ("\C-x4." slime-edit-definition-other-window :inferior t :sldb t)
+    ("\C-x5." slime-edit-definition-other-frame :inferior t :sldb t)
+    ("\M-," slime-pop-find-definition-stack :inferior t :sldb t)
+    ;; Evaluating
+    ("\C-x\C-e" slime-eval-last-expression :inferior t)
+    ("\C-x\M-e" slime-eval-last-expression-display-output :inferior t)
+    ("\C-p" slime-pprint-eval-last-expression :prefixed t :inferior t)
+    ("\C-r" slime-eval-region :prefixed t :inferior t)
+    ("\C-\M-x" slime-eval-defun)
+    (":"    slime-interactive-eval :prefixed t :sldb t)
+    ("\C-e" slime-interactive-eval :prefixed t :sldb t :inferior t)
+    ("\C-y" slime-call-defun :prefixed t)
+    ("E"    slime-edit-value :prefixed t :sldb t :inferior t)
+    ("\C-z" slime-switch-to-output-buffer :prefixed t :sldb t)
+    ("\C-b" slime-interrupt :prefixed t :inferior t :sldb t)
+    ("\M-g" slime-quit :prefixed t :inferior t :sldb t)
+    ;; Documentation
+    (" " slime-space :inferior t)
+    ("\C-f" slime-describe-function :prefixed t :inferior t :sldb t)
+    ("\M-d" slime-disassemble-symbol :prefixed t :inferior t :sldb t)
+    ("\C-t" slime-toggle-trace-fdefinition :prefixed t :sldb t)
+    ("\C-u" slime-undefine-function :prefixed t)
+    ("\C-m" slime-macroexpand-1 :prefixed t :inferior t)
+    ("\M-m" slime-macroexpand-all :prefixed t :inferior t)
+    ("\M-0" slime-restore-window-configuration :prefixed t :inferior t)
+    ([(control meta ?\.)] slime-next-location :inferior t)
+    ("~" slime-sync-package-and-default-directory :prefixed t :inferior t)
+    ("\M-p" slime-repl-set-package :prefixed t :inferior t)
+    ;; Cross reference
+    ("<" slime-list-callers :prefixed t :inferior t :sldb t)
+    (">" slime-list-callees :prefixed t :inferior t :sldb t)
+    ;; "Other"
+    ("\I"  slime-inspect :prefixed t :inferior t :sldb t)
+    ("\C-]" slime-close-all-parens-in-sexp :prefixed t :inferior t :sldb t)
+    ("\C-xt" slime-list-threads :prefixed t :inferior t :sldb t)
+    ("\C-xc" slime-list-connections :prefixed t :inferior t :sldb t)
+    ;; ;; Shadow unwanted bindings from inf-lisp
+    ;; ("\C-a" slime-nop :prefixed t :inferior t :sldb t)
+    ;; ("\C-v" slime-nop :prefixed t :inferior t :sldb t)
+    ))
+
+(defun slime-nop ()
+  "The null command. Used to shadow currently-unused keybindings."
+  (interactive)
+  (call-interactively 'undefined))
+
+(defvar slime-doc-map (make-sparse-keymap)
+  "Keymap for documentation commands. Bound to a prefix key.")
+
+(defvar slime-doc-bindings
+  '((?a slime-apropos)
+    (?z slime-apropos-all)
+    (?p slime-apropos-package)
+    (?d slime-describe-symbol)
+    (?f slime-describe-function)
+    (?h slime-hyperspec-lookup)
+    (?~ common-lisp-hyperspec-format)))
+  
+(defvar slime-who-map (make-sparse-keymap)
+  "Keymap for who-xref commands. Bound to a prefix key.")
+
+(defvar slime-who-bindings
+  '((?c slime-who-calls)
+    (?w slime-calls-who)
+    (?r slime-who-references)
+    (?b slime-who-binds)
+    (?s slime-who-sets)
+    (?m slime-who-macroexpands)
+    (?a slime-who-specializes)))
+
+;; Maybe a good idea, maybe not..
+(defvar slime-prefix-key "\C-c"
+  "The prefix key to use in SLIME keybinding sequences.")
+
+(defun* slime-define-key (key command &key prefixed inferior)
+  "Define a keybinding of KEY for COMMAND.
+If PREFIXED is non-nil, `slime-prefix-key' is prepended to KEY."
+  (when prefixed
+    (setq key (concat slime-prefix-key key)))
+  (define-key slime-mode-map key command))
+
+(defun slime-init-keymaps ()
+  "(Re)initialize the keymaps for `slime-mode'."
+  (interactive)
+  (loop for (key command . keys) in slime-keys
+        do (apply #'slime-define-key key command :allow-other-keys t keys))
+  ;; Documentation
+  (setq slime-doc-map (make-sparse-keymap))
+  (loop for (key command) in slime-doc-bindings
+        do (progn
+             ;; We bind both unmodified and with control.
+             (define-key slime-doc-map (vector key) command)
+             (unless (equal key ?h)     ; But don't bind C-h
+               (let ((modified (slime-control-modified-char key)))
+                 (define-key slime-doc-map (vector modified) command)))))
+  ;; C-c C-d is the prefix for the doc map.
+  (slime-define-key "\C-d" slime-doc-map :prefixed t :inferior t)
+  ;; Who-xref
+  (setq slime-who-map (make-sparse-keymap))
+  (loop for (key command) in slime-who-bindings
+        do (progn
+             ;; We bind both unmodified and with control.
+             (define-key slime-who-map (vector key) command)
+             (let ((modified (slime-control-modified-char key)))
+                 (define-key slime-who-map (vector modified) command))))
+  ;; C-c C-w is the prefix for the who-xref map.
+  (slime-define-key "\C-w" slime-who-map :prefixed t :inferior t))
+
+(defun slime-control-modified-char (char)
+  "Return the control-modified version of CHAR."
+  ;; Maybe better to just bitmask it?
+  (read (format "?\\C-%c" char)))
+
+(slime-init-keymaps)
+
+
+;;;; Setup initial `slime-mode' hooks
+
+(make-variable-buffer-local
+ (defvar slime-pre-command-actions nil
+   "List of functions to execute before the next Emacs command.
+This list of flushed between commands."))
+
+(defun slime-pre-command-hook ()
+  "Execute all functions in `slime-pre-command-actions', then NIL it."
+  (dolist (undo-fn slime-pre-command-actions)
+    (ignore-errors (funcall undo-fn)))
+  (setq slime-pre-command-actions nil))
+
+(defun slime-post-command-hook ()
+  (when (null pre-command-hook) ; sometimes this is lost
+    (add-hook 'pre-command-hook 'slime-pre-command-hook)))
+
+(defun slime-setup-command-hooks ()
+  "Setup a buffer-local `pre-command-hook' to call `slime-pre-command-hook'."
+  (add-local-hook 'pre-command-hook 'slime-pre-command-hook) 
+  (add-local-hook 'post-command-hook 'slime-post-command-hook))
+
+
+;;;; Framework'ey bits
+;;;
+;;; This section contains some standard SLIME idioms: basic macros,
+;;; ways of showing messages to the user, etc. All the code in this
+;;; file should use these functions when applicable.
+;;;
+;;;;; Syntactic sugar
+
+(defmacro* when-let ((var value) &rest body)
+  "Evaluate VALUE, and if the result is non-nil bind it to VAR and
+evaluate BODY.
+
+\(fn (VAR VALUE) &rest BODY)"
+  `(let ((,var ,value))
+     (when ,var , at body)))
+
+(put 'when-let 'lisp-indent-function 1)
+
+(defmacro with-lexical-bindings (variables &rest body)
+  "Execute BODY with VARIABLES in lexical scope."
+  `(lexical-let ,(mapcar (lambda (variable) (list variable variable))
+                         variables)
+     , at body))
+
+(put 'with-lexical-bindings 'lisp-indent-function 1)
+
+(defmacro destructure-case (value &rest patterns)
+  "Dispatch VALUE to one of PATTERNS.
+A cross between `case' and `destructuring-bind'.
+The pattern syntax is:
+  ((HEAD . ARGS) . BODY)
+The list of patterns is searched for a HEAD `eq' to the car of
+VALUE. If one is found, the BODY is executed with ARGS bound to the
+corresponding values in the CDR of VALUE."
+  (let ((operator (gensym "op-"))
+	(operands (gensym "rand-"))
+	(tmp (gensym "tmp-")))
+    `(let* ((,tmp ,value)
+	    (,operator (car ,tmp))
+	    (,operands (cdr ,tmp)))
+       (case ,operator
+	 ,@(mapcar (lambda (clause)
+                     (if (eq (car clause) t)
+                         `(t ,@(cdr clause))
+                       (destructuring-bind ((op &rest rands) &rest body) clause
+                         `(,op (destructuring-bind ,rands ,operands
+                                 . ,body)))))
+		   patterns)
+	 ,@(if (eq (caar (last patterns)) t)
+	       '()
+	     `((t (error "Elisp destructure-case failed: %S" ,tmp))))))))
+
+(put 'destructure-case 'lisp-indent-function 1)
+
+(defmacro slime-define-keys (keymap &rest key-command)
+  "Define keys in KEYMAP. Each KEY-COMMAND is a list of (KEY COMMAND)."
+  `(progn . ,(mapcar (lambda (k-c) `(define-key ,keymap . ,k-c))
+		     key-command)))
+
+(put 'slime-define-keys 'lisp-indent-function 1)
+
+(defmacro* with-struct ((conc-name &rest slots) struct &body body)
+  "Like with-slots but works only for structs.
+\(fn (CONC-NAME &rest SLOTS) STRUCT &body BODY)"
+  (flet ((reader (slot) (intern (concat (symbol-name conc-name)
+					(symbol-name slot)))))
+    (let ((struct-var (gensym "struct")))
+      `(let ((,struct-var ,struct))
+	 (symbol-macrolet
+	     ,(mapcar (lambda (slot)
+			(etypecase slot
+			  (symbol `(,slot (,(reader slot) ,struct-var)))
+			  (cons `(,(first slot) (,(reader (second slot)) 
+						 ,struct-var)))))
+		      slots)
+	   . ,body)))))
+
+(put 'with-struct 'lisp-indent-function 2)
+
+;;;;; Very-commonly-used functions
+
+(defvar slime-message-function 'message)
+
+;; Interface
+(defun slime-message (format &rest args)
+  "Like `message' but with special support for multi-line messages.
+Single-line messages use the echo area."
+  (apply slime-message-function format args))
+
+(when (or (featurep 'xemacs)
+          (= emacs-major-version 20))
+  (setq slime-message-function 'slime-format-display-message))
+
+(defun slime-format-display-message (format &rest args)
+  (slime-display-message (apply #'format format args) "*SLIME Note*"))
+
+(defun slime-display-message (message buffer-name) 
+  "Display MESSAGE in the echo area or in BUFFER-NAME.
+Use the echo area if MESSAGE needs only a single line.  If the MESSAGE
+requires more than one line display it in BUFFER-NAME and add a hook
+to `slime-pre-command-actions' to remove the window before the next
+command."
+  (when (get-buffer-window buffer-name) (delete-windows-on buffer-name))
+  (cond ((or (string-match "\n" message)
+             (> (length message) (1- (frame-width))))
+         (lexical-let ((buffer (get-buffer-create buffer-name)))
+           (with-current-buffer buffer
+             (erase-buffer)
+             (insert message)
+             (goto-char (point-min))
+             (let ((win (slime-create-message-window)))
+               (set-window-buffer win (current-buffer))
+               (shrink-window-if-larger-than-buffer
+                (display-buffer (current-buffer)))))
+           (push (lambda () (delete-windows-on buffer) (bury-buffer buffer))
+                 slime-pre-command-actions)))
+        (t (message "%s" message))))
+
+(defun slime-create-message-window ()
+  "Create a window at the bottom of the frame, above the minibuffer."
+  (let ((previous (previous-window (minibuffer-window))))
+    (when (<= (window-height previous) (* 2 window-min-height))
+      (save-selected-window 
+        (select-window previous)
+        (enlarge-window (- (1+ (* 2 window-min-height))
+                           (window-height previous)))))
+    (split-window previous)))
+
+(defvar slime-background-message-function 'slime-display-oneliner)
+
+;; Interface
+(defun slime-background-message (format-string &rest format-args)
+  "Display a message in passing.
+This is like `slime-message', but less distracting because it
+will never pop up a buffer or display multi-line messages.
+It should be used for \"background\" messages such as argument lists."
+  (apply slime-background-message-function format-string format-args))
+
+(defun slime-display-oneliner (format-string &rest format-args)
+  (let* ((msg (apply #'format format-string format-args)))
+    (unless (minibuffer-window-active-p (minibuffer-window))
+      (message  "%s" (slime-oneliner msg)))))
+
+(defun slime-oneliner (string)
+  "Return STRING truncated to fit in a single echo-area line."
+  (substring string 0 (min (length string)
+                           (or (position ?\n string) most-positive-fixnum)
+                           (1- (frame-width)))))
+
+;; Interface
+(defun slime-set-truncate-lines ()
+  "Apply `slime-truncate-lines' to the current buffer."
+  (when slime-truncate-lines
+    (set (make-local-variable 'truncate-lines) t)))
+
+;; Interface
+(defun slime-read-package-name (prompt &optional initial-value)
+  "Read a package name from the minibuffer, prompting with PROMPT."
+  (let ((completion-ignore-case t))
+    (completing-read prompt (slime-bogus-completion-alist 
+                             (slime-eval 
+                              `(swank:list-all-package-names t)))
+		     nil t initial-value)))
+
+;; Interface
+(defun slime-read-symbol-name (prompt &optional query)
+  "Either read a symbol name or choose the one at point.
+The user is prompted if a prefix argument is in effect, if there is no
+symbol at point, or if QUERY is non-nil.
+
+This function avoids mistaking the REPL prompt for a symbol."
+  (cond ((or current-prefix-arg query (not (slime-symbol-name-at-point)))
+         (slime-read-from-minibuffer prompt (slime-symbol-name-at-point)))
+        (t (slime-symbol-name-at-point))))
+
+;; Interface
+(defmacro slime-propertize-region (props &rest body)
+  "Execute BODY and add PROPS to all the text it inserts.
+More precisely, PROPS are added to the region between the point's
+positions before and after executing BODY."
+  (let ((start (gensym)))
+    `(let ((,start (point)))
+       (prog1 (progn , at body)
+	 (add-text-properties ,start (point) ,props)))))
+
+(put 'slime-propertize-region 'lisp-indent-function 1)
+
+;; Interface
+(defsubst slime-insert-propertized (props &rest args)
+  "Insert all ARGS and then add text-PROPS to the inserted text."
+  (slime-propertize-region props (apply #'insert args)))
+
+(defmacro slime-with-rigid-indentation (level &rest body)
+  "Execute BODY and then rigidly indent its text insertions.
+Assumes all insertions are made at point."
+  (let ((start (gensym)) (l (gensym)))
+    `(let ((,start (point)) (,l ,(or level '(current-column))))
+       (prog1 (progn , at body)
+         (slime-indent-rigidly ,start (point) ,l)))))
+
+(put 'slime-with-rigid-indentation 'lisp-indent-function 1)
+
+(defun slime-indent-rigidly (start end column)
+  ;; Similar to `indent-rigidly' but doesn't inherit text props.
+  (save-excursion
+    (goto-char end)
+    (beginning-of-line)
+    (while (and (<= start (point))
+                (progn
+                  (save-excursion (insert-char ?\  column))
+                  (zerop (forward-line -1)))))))
+
+(defun slime-insert-indented (&rest strings)
+  "Insert all arguments rigidly indented."
+  (slime-with-rigid-indentation nil
+    (apply #'insert strings)))
+
+(defun slime-curry (fun &rest args)
+  `(lambda (&rest more) (apply ',fun (append ',args more))))
+
+(defun slime-rcurry (fun &rest args)
+  `(lambda (&rest more) (apply ',fun (append more ',args))))
+
+;;;;; Snapshots of current Emacs state
+
+;;; Window configurations do not save (and hence not restore)
+;;; any narrowing that could be applied to a buffer.
+;;;
+;;; For this purpose, we introduce a superset of a window
+;;; configuration that does include the necessary information to
+;;; properly restore narrowing.
+;;;
+;;; We call this superset an Emacs Snapshot.
+
+(defstruct (slime-narrowing-configuration
+             (:conc-name slime-narrowing-configuration.))
+  narrowedp beg end)
+
+(defstruct (slime-emacs-snapshot (:conc-name slime-emacs-snapshot.))
+  window-configuration narrowing-configuration)
+
+(defun slime-current-narrowing-configuration (&optional buffer)
+  (with-current-buffer (or buffer (current-buffer))
+    (make-slime-narrowing-configuration :narrowedp (slime-buffer-narrowed-p)
+                                        :beg (point-min-marker)
+                                        :end (point-max-marker))))
+
+(defun slime-set-narrowing-configuration (narrowing-cfg)
+  (when (slime-narrowing-configuration.narrowedp narrowing-cfg)
+    (narrow-to-region (slime-narrowing-configuration.beg narrowing-cfg)
+                      (slime-narrowing-configuration.end narrowing-cfg))))
+
+(defun slime-current-emacs-snapshot (&optional frame)
+  "Returns a snapshot of the current state of FRAME, or the
+currently active frame if FRAME is not given respectively."
+  (with-current-buffer
+      (if frame
+          (window-buffer (frame-selected-window (selected-frame)))
+          (current-buffer))
+    (make-slime-emacs-snapshot
+     :window-configuration    (current-window-configuration frame)
+     :narrowing-configuration (slime-current-narrowing-configuration))))
+
+(defun slime-set-emacs-snapshot (snapshot)
+  "Restores the state of Emacs according to the information saved
+in SNAPSHOT."
+  (let ((window-cfg    (slime-emacs-snapshot.window-configuration snapshot))
+        (narrowing-cfg (slime-emacs-snapshot.narrowing-configuration snapshot)))
+    (set-window-configuration window-cfg) ; restores previously current buffer.
+    (slime-set-narrowing-configuration narrowing-cfg)))
+
+(defun slime-current-emacs-snapshot-fingerprint (&optional frame)
+  "Return a fingerprint of the current emacs snapshot.
+Fingerprints are `equalp' if and only if they represent window
+configurations that are very similar (same windows and buffers.)
+
+Unlike real window-configuration objects, fingerprints are not
+sensitive to the point moving and they can't be restored."
+  (mapcar (lambda (window) (list window (window-buffer window)))
+          (slime-frame-windows frame)))
+
+(defun slime-frame-windows (&optional frame)
+  "Return the list of windows in FRAME."
+  (loop with last-window = (previous-window (frame-first-window frame))
+        for window = (frame-first-window frame) then (next-window window)
+        collect window
+        until (eq window last-window)))
+
+
+(defmacro save-restriction-if-possible (&rest body)
+  "Very similiarly to `save-restriction'. The only difference is
+that it's not enforcing the restriction as strictly: It's only
+enforced if `point' was not moved outside of the restriction
+after executing BODY.
+
+Example: 
+
+  (progn (goto-line 1000)
+         (narrow-to-page) 
+         (save-restriction-if-possible (widen) (goto-line 999)))
+
+  In this case, the buffer is narrowed to the current page, and
+  point is on line 999.
+
+  (progn (goto-char 1000)
+         (narrow-to-page) 
+         (save-restriction-if-possible (widen) (goto-line 1)))
+
+  Whereas in this case, the buffer is widened and point is on
+  line 1."
+  (let ((gcfg (gensym "NARROWING-CFG+"))
+        (gbeg (gensym "OLDBEG+"))
+        (gend (gensym "OLDEND+")))
+    `(let ((,gcfg (slime-current-narrowing-configuration)))
+       (unwind-protect (progn , at body)
+         (let ((,gbeg (slime-narrowing-configuration.beg ,gcfg))
+               (,gend (slime-narrowing-configuration.end ,gcfg)))
+           (when (and (>= (point) ,gbeg) (<= (point) ,gend))
+             (slime-set-narrowing-configuration ,gcfg)))))))
+
+(put 'save-restriction-if-possible 'lisp-indent-function 0)
+
+;;;;; Temporary popup buffers
+
+(make-variable-buffer-local
+ (defvar slime-temp-buffer-saved-emacs-snapshot nil
+   "The snapshot of the current state in Emacs before the temp-buffer
+was displayed, so that this state can be restored later on.
+Buffer local in temp-buffers."))
+
+(make-variable-buffer-local
+ (defvar slime-temp-buffer-saved-fingerprint nil
+   "The emacs snapshot \"fingerprint\" after displaying the buffer."))
+
+;; Interface
+(defun* slime-get-temp-buffer-create (name &key mode noselectp reusep 
+                                           emacs-snapshot)
+  "Return a fresh temporary buffer called NAME in MODE.
+The buffer also uses the minor-mode `slime-temp-buffer-mode'. Pressing
+`q' in the buffer will restore the window configuration to the way it
+is when the buffer was created, i.e. when this function was called.
+
+If NOSELECTP is true, then the buffer is shown by `display-buffer',
+otherwise it is shown and selected by `pop-to-buffer'.
+
+If REUSEP is true and a buffer does already exist with name NAME,
+then the buffer will be reused instead of being killed.
+
+If EMACS-SNAPSHOT is non-NIL, it's used to restore the previous
+state of Emacs after closing the temporary buffer. Otherwise, the
+current state will be saved and later restored.
+"
+  (let ((snapshot (or emacs-snapshot (slime-current-emacs-snapshot)))
+        (buffer (get-buffer name)))
+    (when (and buffer (not reusep))
+      (kill-buffer name)
+      (setq buffer nil))
+    (with-current-buffer (or buffer (get-buffer-create name))
+      (when mode
+        (let ((original-configuration slime-temp-buffer-saved-emacs-snapshot)
+              (original-fingerprint slime-temp-buffer-saved-fingerprint))
+          (funcall mode)
+          (setq slime-temp-buffer-saved-emacs-snapshot original-configuration)
+          (setq slime-temp-buffer-saved-fingerprint original-fingerprint)))
+      (slime-temp-buffer-mode 1)
+      (let ((window (get-buffer-window (current-buffer))))
+        (if window
+            (unless noselectp
+              (select-window window))
+            (progn
+              (if noselectp
+                  (display-buffer (current-buffer) t)
+                  (pop-to-buffer (current-buffer))
+                  (selected-window))
+              (setq slime-temp-buffer-saved-emacs-snapshot snapshot)
+              (setq slime-temp-buffer-saved-fingerprint
+                    (slime-current-emacs-snapshot-fingerprint)))))
+      (current-buffer))))
+
+;; Interface
+(defmacro* slime-with-output-to-temp-buffer ((name &key mode reusep)
+                                             package &rest body)
+  "Similar to `with-output-to-temp-buffer'.
+Also saves the current state of Emacs (window configuration &c),
+and inherits the current `slime-connection' in a buffer-local
+variable. Cf. `slime-get-temp-buffer-create'"
+  `(let ((connection (slime-connection))
+         (standard-output (slime-get-temp-buffer-create ,name :mode ',mode 
+                                                        :reusep ,reusep)))
+     (prog1 (with-current-buffer standard-output
+              ;; set explicitely to NIL in case the buffer got reused. (REUSEP)
+              (let ((buffer-read-only nil)) , at body))
+       (with-current-buffer standard-output
+         (setq slime-buffer-connection connection)
+         (setq slime-buffer-package ,package)
+         (goto-char (point-min))
+         (slime-mode 1)
+         (set-syntax-table lisp-mode-syntax-table)
+         (setq buffer-read-only t)))))
+
+(put 'slime-with-output-to-temp-buffer 'lisp-indent-function 2)
+
+(define-minor-mode slime-temp-buffer-mode 
+  "Mode for displaying read only stuff"
+  nil
+  " temp"
+  '(("q" . slime-temp-buffer-quit)))
+
+;; Interface
+(defun slime-temp-buffer-quit (&optional kill-buffer-p)
+  "Get rid of the current (temp) buffer without asking. Restore the
+window configuration unless it was changed since we last activated the buffer."
+  (interactive)
+  (let ((snapshot slime-temp-buffer-saved-emacs-snapshot)
+        (temp-buffer (current-buffer)))
+    (setq slime-temp-buffer-saved-emacs-snapshot nil)
+    (if (and snapshot (equalp (slime-current-emacs-snapshot-fingerprint)
+                              slime-temp-buffer-saved-fingerprint))
+        (slime-set-emacs-snapshot snapshot)
+        (bury-buffer))
+    (when kill-buffer-p
+      (kill-buffer temp-buffer))))
+
+;;;;; Filename translation
+;;;
+;;; Filenames passed between Emacs and Lisp should be translated using
+;;; these functions. This way users who run Emacs and Lisp on separate
+;;; machines have a chance to integrate file operations somehow.
+
+(defun slime-to-lisp-filename (filename)
+  "Translate the string FILENAME to a Lisp filename.
+See `slime-filename-translations'."
+  (funcall (first (slime-find-filename-translators (slime-machine-instance)))
+           (expand-file-name filename)))
+
+(defun slime-from-lisp-filename (filename)
+  "Translate the Lisp filename FILENAME to an Emacs filename.
+See `slime-filename-translations'."
+  (funcall (second (slime-find-filename-translators (slime-machine-instance)))
+           filename))
+
+(defun slime-find-filename-translators (hostname)
+  (cond ((and hostname slime-filename-translations)
+         (or (cdr (assoc-if (lambda (regexp) (string-match regexp hostname))
+                            slime-filename-translations))
+             (error "No filename-translations for hostname: %s" hostname)))
+        (t (list #'identity #'identity))))
+
+
+;;;; Starting SLIME
+;;;
+;;; This section covers starting an inferior-lisp, compiling and
+;;; starting the server, initiating a network connection.
+
+;;;;; Entry points
+
+;; We no longer load inf-lisp, but we use this variable for backward
+;; compatibility.
+(defvar inferior-lisp-program "lisp" 
+  "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
+
+(defvar slime-lisp-implementations nil
+  "*A list of known Lisp implementations.
+The list should have the form: 
+  ((NAME (PROGRAM PROGRAM-ARGS...) &key INIT CODING-SYSTEM) ...)
+
+NAME is a symbol for the implementation.
+PROGRAM and PROGRAM-ARGS are strings used to start the Lisp process.
+INIT is a function that should return a string to load and start
+  Swank. The function will be called with the PORT-FILENAME and ENCODING as
+  arguments.  INIT defaults to `slime-init-command'. 
+CODING-SYSTEM a symbol for the coding system. The default is 
+  slime-net-coding-system
+
+Here's an example: 
+ ((cmucl (\"/opt/cmucl/bin/lisp\" \"-quiet\") :init slime-init-command)
+  (acl (\"acl7\") :coding-system emacs-mule))")
+
+(defvar slime-default-lisp nil
+  "*The name of the default Lisp implementation.
+See `slime-lisp-implementations'")
+
+(defvar slime-lisp-host "127.0.0.1"
+  "The default hostname (or IP address) to connect to.")
+
+;; dummy definitions for the compiler
+(defvar slime-net-coding-system)
+(defvar slime-net-processes)
+(defvar slime-default-connection)
+
+(defun slime (&optional command coding-system)
+  "Start an inferior^_superior Lisp and connect to its Swank server."
+  (interactive)
+  (let ((inferior-lisp-program (or command inferior-lisp-program))
+        (slime-net-coding-system (or coding-system slime-net-coding-system)))
+    (slime-start* (slime-read-interactive-args))))
+
+(defvar slime-inferior-lisp-program-history '()
+  "History list of command strings.  Used by `slime'.")
+                                                  
+(defun slime-read-interactive-args ()
+  "Return the list of args which should be passed to `slime-start'.
+
+The rules for selecting the arguments are rather complicated:
+
+- In the most common case, i.e. if there's no prefix-arg in
+  effect and if `slime-lisp-implementations' is nil, use
+  `inferior-lisp-program' as fallback.
+
+- If the table `slime-lisp-implementations' is non-nil use the
+  implementation with name `slime-default-lisp' or if that's nil
+  the first entry in the table.
+
+- If the prefix-arg is `-', prompt for one of the registered
+  lisps.
+
+- If the prefix-arg is positive, read the command to start the
+  process."
+  (let ((table slime-lisp-implementations))
+    (cond ((not current-prefix-arg) (slime-lisp-options))
+          ((eq current-prefix-arg '-)
+           (let ((key (completing-read 
+                       "Lisp name: " (mapcar (lambda (x) 
+                                               (list (symbol-name (car x)))) 
+                                             table)
+                       nil t)))
+             (slime-lookup-lisp-implementation table (intern key))))
+          (t
+           (destructuring-bind (program &rest program-args)
+               (split-string (read-string 
+                              "Run lisp: " inferior-lisp-program
+                              'slime-inferior-lisp-program-history))
+             (let ((coding-system 
+                    (if (eq 16 (prefix-numeric-value current-prefix-arg))
+                        (read-coding-system "set slime-coding-system: "
+                                            slime-net-coding-system)
+                      slime-net-coding-system)))
+               (list :program program :program-args program-args
+                     :coding-system coding-system)))))))
+
+(defun slime-lisp-options (&optional name)
+  (let ((table slime-lisp-implementations))
+    (assert (or (not name) table))
+    (cond (table (slime-lookup-lisp-implementation slime-lisp-implementations 
+                                                   (or name slime-default-lisp
+                                                       (car (car table)))))
+          (t (destructuring-bind (program &rest args)
+                 (split-string inferior-lisp-program)
+               (list :program program :program-args args))))))
+
+(defun slime-lookup-lisp-implementation (table name)
+  (destructuring-bind (name (prog &rest args) &rest keys) (assoc name table)
+    (list* :name name :program prog :program-args args keys)))
+
+(defun* slime-start (&key (program inferior-lisp-program) program-args 
+                          directory
+                          (coding-system slime-net-coding-system)
+                          (init 'slime-init-command)
+                          name
+                          (buffer "*inferior-lisp*")
+                          init-function)
+  (let ((args (list :program program :program-args program-args :buffer buffer 
+                    :coding-system coding-system :init init :name name
+                    :init-function init-function)))
+    (slime-check-coding-system coding-system)
+    (when (slime-bytecode-stale-p)
+      (slime-urge-bytecode-recompile))
+    (let ((proc (slime-maybe-start-lisp program program-args 
+                                        directory buffer)))
+      (slime-inferior-connect proc args)
+      (pop-to-buffer (process-buffer proc)))))
+
+(defun slime-start* (options)
+  (apply #'slime-start options))
+
+(defun slime-connect (host port &optional coding-system)
+  "Connect to a running Swank server."
+  (interactive (list (read-from-minibuffer "Host: " slime-lisp-host)
+                     (read-from-minibuffer "Port: " "4005" nil t)))
+  (when (and (interactive-p) slime-net-processes
+             (y-or-n-p "Close old connections first? "))
+    (slime-disconnect))
+  (message "Connecting to Swank on port %S.." port)
+  (let ((coding-system (or coding-system slime-net-coding-system)))
+    (slime-check-coding-system coding-system)
+    (message "Connecting to Swank on port %S.." port)
+    (let* ((process (slime-net-connect host port coding-system))
+           (slime-dispatching-connection process))
+      (slime-setup-connection process))))
+
+(defun slime-start-and-load (filename &optional package)
+  "Start Slime, if needed, load the current file and set the package."
+  (interactive (list (expand-file-name (buffer-file-name))
+                     (slime-find-buffer-package)))
+  (cond ((slime-connected-p)
+         (slime-load-file-set-package filename package))
+        (t
+         (slime-start-and-init (slime-lisp-options)
+                               (slime-curry #'slime-start-and-load 
+                                            filename package)))))
+
+(defun slime-start-and-init (options fun)
+  (let* ((rest (plist-get options :init-function))
+         (init (cond (rest `(lambda () (funcall ',rest) (funcall ',fun)))
+                     (t fun))))
+    (slime-start* (plist-put (copy-list options) :init-function init))))
+
+(defun slime-load-file-set-package (filename package)
+  (let ((filename (slime-to-lisp-filename filename)))
+    (slime-eval-async `(swank:load-file-set-package ,filename ,package)
+                      (lambda (package)
+                        (when package
+                          (slime-repl-set-package (second package)))))))
+
+;;;;; Start inferior lisp
+;;;
+;;; Here is the protocol for starting SLIME:
+;;;
+;;;   0. Emacs recompiles/reloads slime.elc if it exists and is stale.
+;;;   1. Emacs starts an inferior Lisp process.
+;;;   2. Emacs tells Lisp (via stdio) to load and start Swank.
+;;;   3. Lisp recompiles the Swank if needed.
+;;;   4. Lisp starts the Swank server and writes its TCP port to a temp file.
+;;;   5. Emacs reads the temp file to get the port and then connects.
+;;;   6. Emacs prints a message of warm encouragement for the hacking ahead.
+;;;
+;;; Between steps 2-5 Emacs polls for the creation of the temp file so
+;;; that it can make the connection. This polling may continue for a
+;;; fair while if Swank needs recompilation.
+
+(defvar slime-connect-retry-timer nil
+  "Timer object while waiting for an inferior-lisp to start.")
+
+;;; Recompiling bytecode:
+
+(defun slime-bytecode-stale-p ()
+  "Return true if slime.elc is older than slime.el."
+  (when-let (libfile (locate-library "slime"))
+    (let* ((basename (file-name-sans-extension libfile))
+           (sourcefile (concat basename ".el"))
+           (bytefile (concat basename ".elc")))
+      (and (file-exists-p bytefile)
+           (file-newer-than-file-p sourcefile bytefile)))))
+
+(defun slime-recompile-bytecode ()
+  "Recompile and reload slime.
+Warning: don't use this in XEmacs, it seems to crash it!"
+  (interactive)
+  (let ((sourcefile (concat (file-name-sans-extension (locate-library "slime"))
+                            ".el")))
+    (byte-compile-file sourcefile t)))
+
+(defun slime-urge-bytecode-recompile ()
+  "Urge the user to recompile slime.elc.
+Return true if we have been given permission to continue."
+  (cond ((featurep 'xemacs)
+         ;; My XEmacs crashes and burns if I recompile/reload an elisp
+         ;; file from itself. So they have to do it themself.
+         (or (y-or-n-p "slime.elc is older than source.  Continue? ")
+             (signal 'quit nil)))
+        ((y-or-n-p "slime.elc is older than source.  Recompile first? ")
+         (slime-recompile-bytecode))
+        (t)))
+
+(defun slime-abort-connection ()
+  "Abort connection the current connection attempt."
+  (interactive)
+  (cond (slime-connect-retry-timer
+         (slime-cancel-connect-retry-timer)
+         (message "Cancelled connection attempt."))
+        (t (error "Not connecting"))))
+
+;;; Starting the inferior Lisp and loading Swank:
+
+(defun slime-maybe-start-lisp (program program-args directory buffer)
+  "Return a new or existing inferior lisp process."
+  (cond ((not (comint-check-proc buffer))
+         (slime-start-lisp program program-args directory buffer))
+        ((slime-reinitialize-inferior-lisp-p program program-args buffer)
+         (when-let (conn (find (get-buffer-process buffer) slime-net-processes 
+                               :key #'slime-inferior-process))
+           (slime-net-close conn))
+         (get-buffer-process buffer))
+        (t (slime-start-lisp program program-args
+                             directory
+                             (generate-new-buffer-name buffer)))))
+
+(defun slime-reinitialize-inferior-lisp-p (program program-args buffer)
+  (let ((args (slime-inferior-lisp-args (get-buffer-process buffer))))
+    (and (equal (plist-get args :program) program)
+         (equal (plist-get args :program-args) program-args)
+         (not (y-or-n-p "Create an additional *inferior-lisp*? ")))))
+
+(defun slime-start-lisp (program program-args directory buffer)
+  "Does the same as `inferior-lisp' but less ugly.
+Return the created process."
+  (with-current-buffer (get-buffer-create buffer)
+    (when directory
+      (cd (expand-file-name directory)))
+    (comint-mode)
+    (comint-exec (current-buffer) "inferior-lisp" program nil program-args)
+    (lisp-mode-variables t)
+    (let ((proc (get-buffer-process (current-buffer))))
+      (slime-set-query-on-exit-flag proc)
+      proc)))
+
+(defun slime-inferior-connect (process args)
+  "Start a Swank server in the inferior Lisp and connect."
+  (slime-delete-swank-port-file 'quiet)
+  (slime-start-swank-server process args)
+  (slime-read-port-and-connect process nil))
+
+(defvar slime-inferior-lisp-args nil
+  "A buffer local variable in the inferior proccess.")
+
+(defun slime-start-swank-server (process args)
+  "Start a Swank server on the inferior lisp."
+  (destructuring-bind (&key coding-system init &allow-other-keys) args
+    (with-current-buffer (process-buffer process)
+      (make-local-variable 'slime-inferior-lisp-args)
+      (setq slime-inferior-lisp-args args)
+      (let ((str (funcall init (slime-swank-port-file) coding-system)))
+        (goto-char (process-mark process)) 
+        (insert-before-markers str)
+        (process-send-string process str)))))
+
+(defun slime-inferior-lisp-args (process)
+  (with-current-buffer (process-buffer process)
+    slime-inferior-lisp-args))
+
+;; XXX load-server & start-server used to be separated. maybe that was  better.
+(defun slime-init-command (port-filename coding-system)
+  "Return a string to initialize Lisp."
+  (let ((loader (if (file-name-absolute-p slime-backend)
+                    slime-backend
+                  (concat slime-path slime-backend)))
+        (encoding (slime-coding-system-cl-name coding-system)))
+    ;; Return a single form to avoid problems with buffered input.
+    (format "%S\n\n"
+            `(progn
+               (load ,(expand-file-name loader) :verbose t)
+               (funcall (read-from-string "swank:start-server")
+                        ,port-filename
+                        :coding-system ,encoding)))))
+
+(defun slime-swank-port-file ()
+  "Filename where the SWANK server writes its TCP port number."
+  (concat (file-name-as-directory
+           (cond ((fboundp 'temp-directory) (temp-directory))
+                 ((boundp 'temporary-file-directory) temporary-file-directory)
+                 (t "/tmp/")))
+          (format "slime.%S" (emacs-pid))))
+
+(defun slime-delete-swank-port-file (&optional quiet)
+  (condition-case data
+      (delete-file (slime-swank-port-file))
+    (error
+     (ecase quiet
+       ((nil) (signal (car data) (cdr data)))
+       (quiet)
+       (message (message "Unable to delete swank port file %S"
+                         (slime-swank-port-file)))))))
+
+(defun slime-read-port-and-connect (inferior-process retries)
+  (slime-cancel-connect-retry-timer)
+  (slime-attempt-connection inferior-process retries 1))
+
+(defun slime-attempt-connection (process retries attempt)
+  ;; A small one-state machine to attempt a connection with
+  ;; timer-based retries.
+  (let ((file (slime-swank-port-file))) 
+    (unless (active-minibuffer-window)
+      (message "Polling %S.. (Abort with `M-x slime-abort-connection'.)" file))
+    (unless (slime-connected-p)
+      (slime-set-state (format "[polling:%S]" attempt)))
+    (slime-cancel-connect-retry-timer)
+    (cond ((and (file-exists-p file)
+                (> (nth 7 (file-attributes file)) 0)) ; file size
+           (let ((port (slime-read-swank-port))
+                 (args (slime-inferior-lisp-args process)))
+             (slime-delete-swank-port-file 'message)
+             (let ((c (slime-connect slime-lisp-host port
+                                     (plist-get args :coding-system))))
+               (slime-set-inferior-process c process))))
+          ((and retries (zerop retries))
+           (message "Failed to connect to Swank."))
+          (t
+           (when (and (file-exists-p file) 
+                      (zerop (nth 7 (file-attributes file))))
+             (message "(Zero length port file)")
+             ;; the file may be in the filesystem but not yet written
+             (unless retries (setq retries 3)))
+           (setq slime-connect-retry-timer
+                 (run-with-timer 0.3 nil
+                                 #'slime-timer-call #'slime-attempt-connection 
+                                 process (and retries (1- retries)) 
+                                 (1+ attempt)))))))
+    
+(defun slime-timer-call (fun &rest args)
+  "Call function FUN with ARGS, reporting all errors.
+
+The default condition handler for timer functions (see
+`timer-event-handler') ignores errors."
+  (condition-case data
+      (apply fun args)
+    (error (debug nil (list "Error in timer" fun args data)))))
+
+(defun slime-cancel-connect-retry-timer ()
+  (when slime-connect-retry-timer
+    (cancel-timer slime-connect-retry-timer)
+    (setq slime-connect-retry-timer nil)))
+
+(defun slime-read-swank-port ()
+  "Read the Swank server port number from the `slime-swank-port-file'."
+  (save-excursion
+    (with-temp-buffer
+      (insert-file-contents (slime-swank-port-file))
+      (goto-char (point-min))
+      (let ((port (read (current-buffer))))
+        (assert (integerp port))
+        port))))
+
+(defun slime-hide-inferior-lisp-buffer ()
+  "Display the REPL buffer instead of the *inferior-lisp* buffer."
+  (let* ((buffer (if (slime-process) 
+                     (process-buffer (slime-process))))
+         (window (if buffer (get-buffer-window buffer)))
+         (repl-buffer (slime-output-buffer t))
+         (repl-window (get-buffer-window repl-buffer)))
+    (when buffer
+      (bury-buffer buffer))
+    (cond (repl-window
+           (when window
+             (delete-window window)))
+          (window
+           (set-window-buffer window repl-buffer))
+          (t
+           (pop-to-buffer repl-buffer)
+           (goto-char (point-max))))))
+
+;;; Words of encouragement
+
+(defun slime-user-first-name ()
+  (let ((name (if (string= (user-full-name) "")
+                  (user-login-name)
+                (user-full-name))))
+    (string-match "^[^ ]*" name)
+    (capitalize (match-string 0 name))))
+
+(defvar slime-words-of-encouragement
+  `("Let the hacking commence!"
+    "Hacks and glory await!"
+    "Hack and be merry!"
+    "Your hacking starts... NOW!"
+    "May the source be with you!"
+    "Take this REPL, brother, and may it serve you well."
+    "Lemonodor-fame is but a hack away!"
+    ,(format "%s, this could be the start of a beautiful program."
+             (slime-user-first-name)))
+  "Scientifically-proven optimal words of hackerish encouragement.")
+
+(defun slime-random-words-of-encouragement ()
+  "Return a string of hackerish encouragement."
+  (eval (nth (random (length slime-words-of-encouragement))
+             slime-words-of-encouragement)))
+
+
+;;;; Networking
+;;;
+;;; This section covers the low-level networking: establishing
+;;; connections and encoding/decoding protocol messages.
+;;;
+;;; Each SLIME protocol message beings with a 3-byte length header
+;;; followed by an S-expression as text. The sexp must be readable
+;;; both by Emacs and by Common Lisp, so if it contains any embedded
+;;; code fragments they should be sent as strings.
+;;;
+;;; The set of meaningful protocol messages are not specified
+;;; here. They are defined elsewhere by the event-dispatching
+;;; functions in this file and in swank.lisp.
+
+(defvar slime-net-processes nil
+  "List of processes (sockets) connected to Lisps.")
+
+(defvar slime-net-process-close-hooks '()
+  "List of functions called when a slime network connection closes.
+The functions are called with the process as their argument.")
+
+(defun slime-secret ()
+  "Finds the magic secret from the user's home directory.
+Returns nil if the file doesn't exist or is empty; otherwise the first
+line of the file."
+  (condition-case err
+      (with-temp-buffer
+	(insert-file-contents "~/.slime-secret")
+	(goto-char (point-min))
+	(buffer-substring (point-min) (line-end-position)))
+    (file-error nil)))
+
+;;; Interface
+(defun slime-net-connect (host port coding-system)
+  "Establish a connection with a CL."
+  (let* ((inhibit-quit nil)
+         (proc (open-network-stream "SLIME Lisp" nil host port))
+         (buffer (slime-make-net-buffer " *cl-connection*")))
+    (push proc slime-net-processes)
+    (set-process-buffer proc buffer)
+    (set-process-filter proc 'slime-net-filter)
+    (set-process-sentinel proc 'slime-net-sentinel)
+    (slime-set-query-on-exit-flag proc)
+    (when (fboundp 'set-process-coding-system)
+      (slime-check-coding-system coding-system)
+      (set-process-coding-system proc coding-system coding-system))
+    (when-let (secret (slime-secret))
+      (slime-net-send secret proc))
+    proc))
+
+(defun slime-make-net-buffer (name)
+  "Make a buffer suitable for a network process."
+  (let ((buffer (generate-new-buffer name)))
+    (with-current-buffer buffer
+      (buffer-disable-undo))
+    buffer))
+
+(defun slime-set-query-on-exit-flag (process)
+  "Set PROCESS's query-on-exit-flag to `slime-kill-without-query-p'."
+  (when slime-kill-without-query-p
+    ;; avoid byte-compiler warnings
+    (let ((fun (if (fboundp 'set-process-query-on-exit-flag)
+                   'set-process-query-on-exit-flag
+                 'process-kill-without-query)))
+      (funcall fun process nil))))
+
+;;;;; Coding system madness
+
+(defvar slime-net-valid-coding-systems
+  '((iso-latin-1-unix nil "iso-latin-1-unix")
+    (iso-8859-1-unix  nil "iso-latin-1-unix")
+    (binary           nil "iso-latin-1-unix")
+    (utf-8-unix       t   "utf-8-unix")
+    (emacs-mule-unix  t   "emacs-mule-unix")
+    (euc-jp-unix      t   "euc-jp-unix"))
+  "A list of valid coding systems. 
+Each element is of the form: (NAME MULTIBYTEP CL-NAME)")
+
+(defun slime-find-coding-system (name)
+  "Return the coding system for the symbol NAME.
+The result is either an element in `slime-net-valid-coding-systems'
+of nil."
+  (let* ((probe (assq name slime-net-valid-coding-systems)))
+    (if (and probe (if (fboundp 'check-coding-system)
+                       (ignore-errors (check-coding-system (car probe)))
+                     (eq (car probe) 'binary)))
+        probe)))
+
+(defvar slime-net-coding-system
+  (find-if 'slime-find-coding-system 
+           '(iso-latin-1-unix iso-8859-1-unix binary))
+  "*Coding system used for network connections.
+See also `slime-net-valid-coding-systems'.")
+  
+(defun slime-check-coding-system (coding-system)
+  "Signal an error if CODING-SYSTEM isn't a valid coding system."
+  (interactive)
+  (let ((props (slime-find-coding-system coding-system)))
+    (unless props
+      (error "Invalid slime-net-coding-system: %s. %s"
+             coding-system (mapcar #'car slime-net-valid-coding-systems)))
+    (when (and (second props) (boundp 'default-enable-multibyte-characters))
+      (assert default-enable-multibyte-characters))
+    t))
+
+(defcustom slime-repl-history-file-coding-system 
+  (cond ((slime-find-coding-system 'utf-8-unix) 'utf-8-unix)
+        (t slime-net-coding-system))
+  "*The coding system for the history file."
+  :type 'symbol
+  :group 'slime-repl)
+
+(defun slime-coding-system-mulibyte-p (coding-system)
+  (second (slime-find-coding-system coding-system)))
+
+(defun slime-coding-system-cl-name (coding-system)
+  (third (slime-find-coding-system coding-system)))
+
+;;; Interface
+(defun slime-net-send (sexp proc)
+  "Send a SEXP to Lisp over the socket PROC.
+This is the lowest level of communication. The sexp will be READ and
+EVAL'd by Lisp."
+  (let* ((msg (concat (slime-prin1-to-string sexp) "\n"))
+         (string (concat (slime-net-encode-length (length msg)) msg))
+         (coding-system (cdr (process-coding-system proc))))
+    (slime-log-event sexp)
+    (cond ((slime-safe-encoding-p coding-system string)
+           (process-send-string proc string))
+          (t (error "Coding system %s not suitable for %S"
+                    coding-system string)))))
+
+(defun slime-safe-encoding-p (coding-system string)
+  "Return true iff CODING-SYSTEM can safely encode STRING."
+  (if (featurep 'xemacs)
+      ;; FIXME: XEmacs encodes non-encodeable chars as ?~ automatically
+      t
+    (or (let ((candidates (find-coding-systems-string string))
+              (base (coding-system-base coding-system)))
+          (or (equal candidates '(undecided))
+              (memq base candidates)))
+        (and (not (multibyte-string-p string))
+             (not (slime-coding-system-mulibyte-p coding-system))))))
+
+(defun slime-net-close (process &optional debug)
+  (setq slime-net-processes (remove process slime-net-processes))
+  (when (eq process slime-default-connection)
+    (setq slime-default-connection nil))
+  (cond (debug         
+         (set-process-sentinel process 'ignore)
+         (set-process-filter process 'ignore)
+         (delete-process process))
+        (t
+         (run-hook-with-args 'slime-net-process-close-hooks process)
+         ;; killing the buffer also closes the socket
+         (kill-buffer (process-buffer process)))))
+
+(defun slime-net-sentinel (process message)
+  (message "Lisp connection closed unexpectedly: %s" message)
+  (slime-net-close process)
+  (slime-set-state "[not connected]" process))
+
+;;; Socket input is handled by `slime-net-filter', which decodes any
+;;; complete messages and hands them off to the event dispatcher.
+
+(defun slime-net-filter (process string)
+  "Accept output from the socket and process all complete messages."
+  (with-current-buffer (process-buffer process)
+    (goto-char (point-max))
+    (insert string))
+  (slime-process-available-input process))
+
+(defun slime-run-when-idle (function &rest args)
+  "Call FUNCTION as soon as Emacs is idle."
+  (apply #'run-at-time 
+         (if (featurep 'xemacs) itimer-short-interval 0) 
+         nil function args))
+
+(defun slime-process-available-input (process)
+  "Process all complete messages that have arrived from Lisp."
+  (with-current-buffer (process-buffer process)
+    (while (slime-net-have-input-p)
+      (let ((event (slime-net-read-or-lose process))
+            (ok nil))
+        (slime-log-event event)
+        (unwind-protect
+            (save-current-buffer
+              (slime-dispatch-event event process)
+              (setq ok t))
+          (unless ok
+            (slime-run-when-idle 'slime-process-available-input process)))))))
+
+(defun slime-net-have-input-p ()
+  "Return true if a complete message is available."
+  (goto-char (point-min))
+  (and (>= (buffer-size) 6)
+       (>= (- (buffer-size) 6) (slime-net-decode-length))))
+
+(defun slime-net-read-or-lose (process)
+  (condition-case error
+      (slime-net-read)
+    (error
+     (debug)
+     (slime-net-close process t)
+     (error "net-read error: %S" error))))
+
+(defun slime-net-read ()
+  "Read a message from the network buffer."
+  (goto-char (point-min))
+  (let* ((length (slime-net-decode-length))
+         (start (+ 6 (point)))
+         (end (+ start length)))
+    (assert (plusp length))
+    (let ((string (buffer-substring-no-properties start end)))
+      (prog1 (read string)
+        (delete-region (point-min) end)))))
+
+(defun slime-net-decode-length ()
+  "Read a 24-bit hex-encoded integer from buffer."
+  (string-to-number (buffer-substring-no-properties (point) (+ (point) 6)) 16))
+
+(defun slime-net-encode-length (n)
+  "Encode an integer into a 24-bit hex string."
+  (format "%06x" n))
+
+(defun slime-prin1-to-string (sexp)
+  "Like `prin1-to-string' but don't octal-escape non-ascii characters.
+This is more compatible with the CL reader."
+  (with-temp-buffer
+    (let ((print-escape-nonascii nil)
+          (print-escape-newlines nil))
+      (prin1 sexp (current-buffer))
+      (buffer-string))))
+
+
+;;;; Connections
+;;;
+;;; "Connections" are the high-level Emacs<->Lisp networking concept.
+;;;
+;;; Emacs has a connection to each Lisp process that it's interacting
+;;; with. Typically there would only be one, but a user can choose to
+;;; connect to many Lisps simultaneously.
+;;;
+;;; A connection consists of a control socket, optionally an extra
+;;; socket dedicated to receiving Lisp output (an optimization), and a
+;;; set of connection-local state variables.
+;;;
+;;; The state variables are stored as buffer-local variables in the
+;;; control socket's process-buffer and are used via accessor
+;;; functions. These variables include things like the *FEATURES* list
+;;; and Unix Pid of the Lisp process.
+;;;
+;;; One connection is "current" at any given time. This is:
+;;;   `slime-dispatching-connection' if dynamically bound, or
+;;;   `slime-buffer-connection' if this is set buffer-local, or
+;;;   `slime-default-connection' otherwise. 
+;;;
+;;; When you're invoking commands in your source files you'll be using
+;;; `slime-default-connection'. This connection can be interactively
+;;; reassigned via the connection-list buffer.
+;;;
+;;; When a command creates a new buffer it will set
+;;; `slime-buffer-connection' so that commands in the new buffer will
+;;; use the connection that the buffer originated from. For example,
+;;; the apropos command creates the *Apropos* buffer and any command
+;;; in that buffer (e.g. `M-.') will go to the same Lisp that did the
+;;; apropos search. REPL buffers are similarly tied to their
+;;; respective connections.
+;;;
+;;; When Emacs is dispatching some network message that arrived from a
+;;; connection it will dynamically bind `slime-dispatching-connection'
+;;; so that the event will be processed in the context of that
+;;; connection.
+;;;
+;;; This is mostly transparent. The user should be aware that he can
+;;; set the default connection to pick which Lisp handles commands in
+;;; Lisp-mode source buffers, and slime hackers should be aware that
+;;; they can tie a buffer to a specific connection. The rest takes
+;;; care of itself.
+
+(defvar slime-dispatching-connection nil
+  "Network process currently executing.
+This is dynamically bound while handling messages from Lisp; it
+overrides `slime-buffer-connection' and `slime-default-connection'.")
+
+(make-variable-buffer-local
+ (defvar slime-buffer-connection nil
+   "Network connection to use in the current buffer.
+This overrides `slime-default-connection'."))
+
+(defvar slime-default-connection nil
+  "Network connection to use by default.
+Used for all Lisp communication, except when overridden by
+`slime-dispatching-connection' or `slime-buffer-connection'.")
+
+(defun slime-current-connection ()
+  "Return the connection to use for Lisp interaction.
+Return nil if there's no connection."
+  (or slime-dispatching-connection
+      slime-buffer-connection
+      slime-default-connection))
+  
+(defun slime-connection ()
+  "Return the connection to use for Lisp interaction.
+Signal an error if there's no connection."
+  (let ((conn (slime-current-connection)))
+    (cond ((and (not conn) slime-net-processes)
+           (error "No default connection selected."))
+          ((not conn)
+           (error "Not connected."))
+          ((not (eq (process-status conn) 'open))
+           (error "Connection closed."))
+          (t conn))))
+
+(defun slime-select-connection (process)
+  "Make PROCESS the default connection."
+  (setq slime-default-connection process))
+
+(defmacro* slime-with-connection-buffer ((&optional process) &rest body)
+  "Execute BODY in the process-buffer of PROCESS.
+If PROCESS is not specified, `slime-connection' is used.
+
+\(fn (&optional PROCESS) &body BODY))"
+  `(with-current-buffer
+       (process-buffer (or ,process (slime-connection)
+                           (error "No connection")))
+     , at body))
+
+(put 'slime-with-connection-buffer 'lisp-indent-function 1)
+
+(defvar slime-state-name "[??]"
+  "Name of the current state of `slime-default-connection'.
+Just used for informational display in the mode-line.")
+
+(defun slime-set-state (name &optional connection)
+  "Set the current connection's informational state name.
+If this is the default connection then the state will be displayed in
+the modeline."
+  (when (or (not (slime-connected-p))
+            (eq (or connection (slime-connection)) slime-default-connection))
+    (setq slime-state-name name)
+    (force-mode-line-update)))
+
+;;; Connection-local variables:
+
+(defmacro slime-def-connection-var (varname &rest initial-value-and-doc)
+  "Define a connection-local variable.
+The value of the variable can be read by calling the function of the
+same name (it must not be accessed directly). The accessor function is
+setf-able.
+
+The actual variable bindings are stored buffer-local in the
+process-buffers of connections. The accessor function refers to
+the binding for `slime-connection'."
+  (let ((real-var (intern (format "%s:connlocal" varname))))
+    `(progn
+       ;; Variable
+       (make-variable-buffer-local
+        (defvar ,real-var , at initial-value-and-doc))
+       ;; Accessor
+       (defun ,varname (&optional process)
+         (slime-with-connection-buffer (process) ,real-var))
+       ;; Setf
+       (defsetf ,varname (&optional process) (store)
+         `(slime-with-connection-buffer (,process)
+            (setq (\, (quote (\, real-var))) (\, store))
+            (\, store)))
+       '(\, varname))))
+
+(put 'slime-def-connection-var 'lisp-indent-function 2)
+
+;; Let's indulge in some pretty colours.
+(unless (featurep 'xemacs)
+  (font-lock-add-keywords
+   'emacs-lisp-mode
+   '(("(\\(slime-def-connection-var\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"
+      (1 font-lock-keyword-face)
+      (2 font-lock-variable-name-face)))))
+
+(slime-def-connection-var slime-connection-number nil
+  "Serial number of a connection.
+Bound in the connection's process-buffer.")
+
+(slime-def-connection-var slime-lisp-features '()
+  "The symbol-names of Lisp's *FEATURES*.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-lisp-package
+    "COMMON-LISP-USER"
+  "The current package name of the Superior lisp.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-lisp-package-prompt-string
+    "CL-USER"
+  "The current package name of the Superior lisp.
+This is automatically synchronized from Lisp.")
+
+(slime-def-connection-var slime-pid nil
+  "The process id of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-type nil
+  "The implementation type of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-version nil
+  "The implementation type of the Lisp process.")
+
+(slime-def-connection-var slime-lisp-implementation-name nil
+  "The short name for the Lisp implementation.")
+
+(slime-def-connection-var slime-connection-name nil
+  "The short name for connection.")
+
+(slime-def-connection-var slime-inferior-process nil
+  "The inferior process for the connection if any.")
+
+(slime-def-connection-var slime-communication-style nil
+  "The communication style.")
+
+(slime-def-connection-var slime-machine-instance nil
+  "The name of the (remote) machine running the Lisp process.")
+
+;;;;; Connection setup
+
+(defvar slime-connection-counter 0
+  "The number of SLIME connections made. For generating serial numbers.")
+
+;;; Interface
+(defun slime-setup-connection (process)
+  "Make a connection out of PROCESS."
+  (let ((slime-dispatching-connection process))
+    (slime-init-connection-state process)
+    (slime-select-connection process)
+    process))
+
+(defun slime-init-connection-state (proc)
+  "Initialize connection state in the process-buffer of PROC."
+  ;; To make life simpler for the user: if this is the only open
+  ;; connection then reset the connection counter.
+  (when (equal slime-net-processes (list proc))
+    (setq slime-connection-counter 0))
+  (slime-with-connection-buffer ()
+    (setq slime-buffer-connection proc))
+  (setf (slime-connection-number proc) (incf slime-connection-counter))
+  ;; We do the rest of our initialization asynchronously. The current
+  ;; function may be called from a timer, and if we setup the REPL
+  ;; from a timer then it mysteriously uses the wrong keymap for the
+  ;; first command.
+  (slime-eval-async '(swank:connection-info)
+                    (with-lexical-bindings (proc)
+                      (lambda (info)
+                        (slime-set-connection-info proc info)))))
+
+(defun slime-set-connection-info (connection info)
+  "Initialize CONNECTION with INFO received from Lisp."
+  (let ((slime-dispatching-connection connection))
+    (destructuring-bind (&key pid style lisp-implementation machine
+                              features package version &allow-other-keys) info
+      (or (equal version slime-protocol-version)
+          (yes-or-no-p "Protocol version mismatch. Continue anyway? ")
+          (slime-net-close connection)
+          (top-level))
+      (setf (slime-pid) pid
+            (slime-communication-style) style
+            (slime-lisp-features) features)
+      (destructuring-bind (&key name prompt) package
+        (setf (slime-lisp-package) name
+              (slime-lisp-package-prompt-string) prompt))
+      (destructuring-bind (&key type name version) lisp-implementation
+        (setf (slime-lisp-implementation-type) type
+              (slime-lisp-implementation-version) version
+              (slime-lisp-implementation-name) name
+              (slime-connection-name) (slime-generate-connection-name name)))
+      (destructuring-bind (&key instance type version) machine
+        (setf (slime-machine-instance) instance)))
+    (setq slime-state-name "")          ; FIXME
+    (let ((args (when-let (p (slime-inferior-process))
+                  (slime-inferior-lisp-args p))))
+      (when-let (name (plist-get args ':name))
+        (unless (string= (slime-lisp-implementation-name) name)
+          (setf (slime-connection-name)
+                (slime-generate-connection-name (symbol-name name)))))
+      (slime-hide-inferior-lisp-buffer)
+      (slime-init-output-buffer connection)
+      (run-hooks 'slime-connected-hook)
+      (when-let (fun (plist-get args ':init-function))
+        (funcall fun)))
+    (message "Connected. %s" (slime-random-words-of-encouragement))))
+
+(defun slime-generate-connection-name (lisp-name)
+  (loop for i from 1
+        for name = lisp-name then (format "%s<%d>" lisp-name i)
+        while (find name slime-net-processes 
+                    :key #'slime-connection-name :test #'equal)
+        finally (return name)))
+
+(defun slime-connection-close-hook (process)
+  (when (eq process slime-default-connection)
+    (when slime-net-processes
+      (slime-select-connection (car slime-net-processes))
+      (message "Default connection closed; switched to #%S (%S)"
+               (slime-connection-number)
+               (slime-connection-name)))))
+
+(add-hook 'slime-net-process-close-hooks 'slime-connection-close-hook)
+
+;;;;; Commands on connections
+
+(defun slime-disconnect ()
+  "Disconnect all connections."
+  (interactive)
+  (mapc #'slime-net-close slime-net-processes))
+
+(defun slime-make-default-connection ()
+  "Make the current connection the default connection."
+  (interactive)
+  (slime-select-connection (slime-connection))
+  (message "Connection #%S (%s) now default SLIME connection."
+           (slime-connection-number)
+           (slime-connection-name)))
+
+(defun slime-choose-connection ()
+  "Return an established connection chosen by the user."
+  (let ((default (slime-connection-name)))
+    (slime-find-connection-by-name
+     (completing-read (format "Connection name (default %s): " default)
+                      (slime-bogus-completion-alist
+                       (mapcar #'slime-connection-name slime-net-processes))
+                      nil
+                      t
+                      nil
+                      nil
+                      default))))
+
+(defun slime-find-connection-by-name (name)
+  (find name slime-net-processes 
+        :test #'string= :key #'slime-connection-name))
+
+(defun slime-connection-port (connection)
+  "Return the remote port number of CONNECTION."
+  (if (featurep 'xemacs)
+      (car (process-id connection))
+    (cadr (process-contact connection))))
+
+(defun slime-process (&optional connection)
+  "Return the Lisp process for CONNECTION (default `slime-connection').
+Can return nil if there's no process object for the connection."
+  (let ((proc (slime-inferior-process connection)))
+    (if (and proc 
+             (memq (process-status proc) '(run stop)))
+        proc)))
+
+;; Non-macro version to keep the file byte-compilable. 
+(defun slime-set-inferior-process (connection process)
+  (setf (slime-inferior-process connection) process))
+
+(defun slime-use-sigint-for-interrupt (&optional connection)
+  (let ((c (or connection (slime-connection))))
+    (ecase (slime-communication-style c)
+      ((:fd-handler nil) t)
+      ((:spawn :sigio) nil))))
+
+(defvar slime-inhibit-pipelining t
+  "*If true, don't send background requests if Lisp is already busy.")
+
+(defun slime-background-activities-enabled-p ()
+  (and (or slime-mode 
+           (eq major-mode 'sldb-mode)
+           (eq major-mode 'slime-repl-mode))
+       (let ((con (slime-current-connection)))
+         (and con
+              (eq (process-status con) 'open)))
+       (or (not (slime-busy-p))
+           (not slime-inhibit-pipelining))))
+
+
+;;;; Communication protocol
+
+;;;;; Emacs Lisp programming interface
+;;;
+;;; The programming interface for writing Emacs commands is based on
+;;; remote procedure calls (RPCs). The basic operation is to ask Lisp
+;;; to apply a named Lisp function to some arguments, then to do
+;;; something with the result.
+;;;
+;;; Requests can be either synchronous (blocking) or asynchronous
+;;; (with the result passed to a callback/continuation function).  If
+;;; an error occurs during the request then the debugger is entered
+;;; before the result arrives -- for synchronous evaluations this
+;;; requires a recursive edit.
+;;;
+;;; You should use asynchronous evaluations (`slime-eval-async') for
+;;; most things. Reserve synchronous evaluations (`slime-eval') for
+;;; the cases where blocking Emacs is really appropriate (like
+;;; completion) and that shouldn't trigger errors (e.g. not evaluate
+;;; user-entered code).
+;;;
+;;; We have the concept of the "current Lisp package". RPC requests
+;;; always say what package the user is making them from and the Lisp
+;;; side binds that package to *BUFFER-PACKAGE* to use as it sees
+;;; fit. The current package is defined as the buffer-local value of
+;;; `slime-buffer-package' if set, and otherwise the package named by
+;;; the nearest IN-PACKAGE as found by text search (first backwards,
+;;; then forwards).
+;;;
+;;; Similarly we have the concept of the current thread, i.e. which
+;;; thread in the Lisp process should handle the request. The current
+;;; thread is determined solely by the buffer-local value of
+;;; `slime-current-thread'. This is usually bound to t meaning "no
+;;; particular thread", but can also be used to nominate a specific
+;;; thread. The REPL and the debugger both use this feature to deal
+;;; with specific threads.
+
+(make-variable-buffer-local
+ (defvar slime-current-thread t
+   "The id of the current thread on the Lisp side.  
+t means the \"current\" thread;
+:repl-thread the thread that executes REPL requests;
+fixnum a specific thread."))
+
+(make-variable-buffer-local
+ (defvar slime-buffer-package nil
+   "The Lisp package associated with the current buffer.
+This is set only in buffers bound to specific packages."))
+
+;;; `slime-rex' is the RPC primitive which is used to implement both
+;;; `slime-eval' and `slime-eval-async'. You can use it directly if
+;;; you need to, but the others are usually more convenient.
+
+(defmacro* slime-rex ((&rest saved-vars)
+                      (sexp &optional 
+                            (package '(slime-current-package))
+                            (thread 'slime-current-thread))
+                      &rest continuations)
+  "(slime-rex (VAR ...) (SEXP &optional PACKAGE THREAD) CLAUSES ...)
+
+Remote EXecute SEXP.
+
+VARs are a list of saved variables visible in the other forms.  Each
+VAR is either a symbol or a list (VAR INIT-VALUE).
+
+SEXP is evaluated and the princed version is sent to Lisp.
+
+PACKAGE is evaluated and Lisp binds *BUFFER-PACKAGE* to this package.
+The default value is (slime-current-package).
+
+CLAUSES is a list of patterns with same syntax as
+`destructure-case'.  The result of the evaluation of SEXP is
+dispatched on CLAUSES.  The result is either a sexp of the
+form (:ok VALUE) or (:abort).  CLAUSES is executed
+asynchronously.
+
+Note: don't use backquote syntax for SEXP, because Emacs20 cannot
+deal with that."
+  (let ((result (gensym)))
+    `(lexical-let ,(loop for var in saved-vars
+                         collect (etypecase var
+                                   (symbol (list var var))
+                                   (cons var)))
+       (slime-dispatch-event 
+        (list :emacs-rex ,sexp ,package ,thread
+              (lambda (,result)
+                (destructure-case ,result
+                  , at continuations)))))))
+
+(put 'slime-rex 'lisp-indent-function 2)
+
+;;; Interface
+(defun slime-current-package ()
+  "Return the Common Lisp package in the current context.
+If `slime-buffer-package' has a value then return that, otherwise
+search for and read an `in-package' form.
+
+The REPL buffer is a special case: it's package is `slime-lisp-package'."
+  (cond ((eq major-mode 'slime-repl-mode)
+         (slime-lisp-package))
+        (slime-buffer-package)
+        (t (save-restriction
+             (widen)
+             (slime-find-buffer-package)))))
+
+(defvar slime-find-buffer-package-function 'slime-search-buffer-package
+  "*Function to use for `slime-find-buffer-package'.  
+The result should be the package-name (a string)
+or nil if nothing suitable can be found.")
+
+(defun slime-find-buffer-package ()
+  "Figure out which Lisp package the current buffer is associated with."
+  (funcall slime-find-buffer-package-function))
+
+;; When modifing this code consider cases like:
+;;  (in-package #.*foo*)
+;;  (in-package #:cl)
+;;  (in-package :cl)
+;;  (in-package "CL")
+;;  (in-package |CL|)
+;;  (in-package #+ansi-cl :cl #-ansi-cl 'lisp)
+(defun slime-search-buffer-package ()
+  (let ((case-fold-search t)
+        (regexp (concat "^(\\(cl:\\|common-lisp:\\)?in-package\\>[ \n\t\r']*"
+                        "\\([^)]+\\)[ \n\t]*)")))
+    (save-excursion
+      (when (or (re-search-backward regexp nil t)
+                (re-search-forward regexp nil t))
+        (let ((string (match-string-no-properties 2)))
+          (cond ((string-match "^\"" string) (ignore-errors (read string)))
+                ((string-match "^#?:" string) (substring string (match-end 0)))
+                (t string)))))))
+
+;;; Synchronous requests are implemented in terms of asynchronous
+;;; ones. We make an asynchronous request with a continuation function
+;;; that `throw's its result up to a `catch' and then enter a loop of
+;;; handling I/O until that happens.
+
+(defvar slime-stack-eval-tags nil
+  "List of stack-tags of continuations waiting on the stack.")
+
+(defun slime-eval (sexp &optional package)
+  "Evaluate EXPR on the superior Lisp and return the result."
+  (when (null package) (setq package (slime-current-package)))
+  (let* ((tag (gensym (format "slime-result-%d-" 
+                              (1+ (slime-continuation-counter)))))
+	 (slime-stack-eval-tags (cons tag slime-stack-eval-tags)))
+    (apply
+     #'funcall 
+     (catch tag
+       (slime-rex (tag sexp)
+           (sexp package)
+         ((:ok value)
+          (unless (member tag slime-stack-eval-tags)
+            (error "tag = %S eval-tags = %S sexp = %S"
+                   tag slime-stack-eval-tags sexp))
+          (throw tag (list #'identity value)))
+         ((:abort)
+          (throw tag (list #'error "Synchronous Lisp Evaluation aborted."))))
+       (let ((debug-on-quit t)
+             (inhibit-quit nil)
+             (conn (slime-connection)))
+         (while t 
+           (unless (eq (process-status conn) 'open)
+             (error "Lisp connection closed unexpectedly"))
+           (slime-accept-process-output nil 0.01)))))))
+
+(defun slime-eval-async (sexp &optional cont package)
+  "Evaluate EXPR on the superior Lisp and call CONT with the result."
+  (slime-rex (cont (buffer (current-buffer)))
+      (sexp (or package (slime-current-package)))
+    ((:ok result)
+     (when cont
+       (set-buffer buffer)
+       (funcall cont result)))
+    ((:abort)
+     (message "Evaluation aborted."))))
+
+;;; These functions can be handy too:
+
+(defun slime-connected-p ()
+  "Return true if the Swank connection is open."
+  (not (null slime-net-processes)))
+
+(defun slime-check-connected ()
+  "Signal an error if we are not connected to Lisp."
+  (unless (slime-connected-p)
+    (error "Not connected. Use `%s' to start a Lisp."
+           (substitute-command-keys "\\[slime]"))))
+
+(defun slime-busy-p ()
+  "True if Lisp has outstanding requests.
+Debugged requests are ignored."
+  (let ((debugged (sldb-debugged-continuations (slime-connection))))
+    (remove-if (lambda (id) 
+                 (memq id debugged))
+               (slime-rex-continuations)
+               :key #'car)))
+
+;; dummy defvar for compiler
+(defvar slime-repl-read-mode)
+
+(defun slime-reading-p ()
+  "True if Lisp is currently reading input from the REPL."
+  (with-current-buffer (slime-output-buffer)
+    slime-repl-read-mode))
+
+(defun slime-sync ()
+  "Block until the most recent request has finished."
+  (when (slime-rex-continuations)
+    (let ((tag (caar (slime-rex-continuations))))
+      (while (find tag (slime-rex-continuations) :key #'car)
+        (slime-accept-process-output nil 0.1)))))
+
+(defun slime-ping ()
+  "Check that communication works."
+  (interactive)
+  (message "%s" (slime-eval "PONG")))
+ 
+;;;;; Protocol event handler (the guts)
+;;;
+;;; This is the protocol in all its glory. The input to this function
+;;; is a protocol event that either originates within Emacs or arrived
+;;; over the network from Lisp.
+;;;
+;;; Each event is a list beginning with a keyword and followed by
+;;; arguments. The keyword identifies the type of event. Events
+;;; originating from Emacs have names starting with :emacs- and events
+;;; from Lisp don't.
+
+(slime-def-connection-var slime-rex-continuations '()
+  "List of (ID . FUNCTION) continuations waiting for RPC results.")
+
+(slime-def-connection-var slime-continuation-counter 0
+  "Continuation serial number counter.")
+
+(defvar slime-event-hooks)
+
+(defun slime-dispatch-event (event &optional process)
+  (let ((slime-dispatching-connection (or process (slime-connection))))
+    (or (run-hook-with-args-until-success 'slime-event-hooks event)
+        (destructure-case event
+          ((:write-string output &optional target)
+           (slime-write-string output target))
+          ((:emacs-rex form package thread continuation)
+           (slime-set-state "|eval...")
+           (when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
+             (message "; pipelined request... %S" form))
+           (let ((id (incf (slime-continuation-counter))))
+             (push (cons id continuation) (slime-rex-continuations))
+             (slime-send `(:emacs-rex ,form ,package ,thread ,id))))
+          ((:return value id)
+           (let ((rec (assq id (slime-rex-continuations))))
+             (cond (rec (setf (slime-rex-continuations)
+                              (remove rec (slime-rex-continuations)))
+                        (when (null (slime-rex-continuations))
+                          (slime-set-state ""))
+                        (funcall (cdr rec) value))
+                   (t
+                    (error "Unexpected reply: %S %S" id value)))))
+          ((:debug-activate thread level)
+           (assert thread)
+           (sldb-activate thread level))
+          ((:debug thread level condition restarts frames conts)
+           (assert thread)
+           (sldb-setup thread level condition restarts frames conts))
+          ((:debug-return thread level stepping)
+           (assert thread)
+           (sldb-exit thread level stepping))
+          ((:emacs-interrupt thread)
+           (slime-send `(:emacs-interrupt ,thread)))
+          ((:read-string thread tag)
+           (assert thread)
+           (slime-repl-read-string thread tag))
+          ((:y-or-n-p thread tag question)
+           (slime-y-or-n-p thread tag question))
+          ((:read-aborted thread tag)
+           (assert thread)
+           (slime-repl-abort-read thread tag))
+          ((:emacs-return-string thread tag string)
+           (slime-send `(:emacs-return-string ,thread ,tag ,string)))
+          ;;
+          ((:new-package package prompt-string)
+           (setf (slime-lisp-package) package)
+           (setf (slime-lisp-package-prompt-string) prompt-string))
+          ((:new-features features)
+           (setf (slime-lisp-features) features))
+          ((:indentation-update info)
+           (slime-handle-indentation-update info))
+          ((:open-dedicated-output-stream port)
+           (slime-open-stream-to-lisp port))
+          ((:eval-no-wait fun args)
+           (apply (intern fun) args))
+          ((:eval thread tag form-string)
+           (slime-check-eval-in-emacs-enabled)
+           (slime-eval-for-lisp thread tag form-string))
+          ((:emacs-return thread tag value)
+           (slime-send `(:emacs-return ,thread ,tag ,value)))
+          ((:ed what)
+           (slime-ed what))
+          ((:inspect what)
+           (slime-open-inspector what))
+          ((:background-message message)
+           (slime-background-message "%s" message))
+          ((:debug-condition thread message)
+           (assert thread)
+           (message "%s" message))))))
+
+(defun slime-send (sexp)
+  "Send SEXP directly over the wire on the current connection."
+  (slime-net-send sexp (slime-connection)))
+
+(defun slime-reset ()
+  "Clear all pending continuations."
+  (interactive)
+  (setf (slime-rex-continuations) '())
+  (mapc #'kill-buffer (sldb-buffers)))
+
+(defun slime-send-sigint ()
+  (interactive)
+  (signal-process (slime-pid) 'SIGINT))
+
+;;;;; Event logging to *slime-events*
+;;;
+;;; The *slime-events* buffer logs all protocol messages for debugging
+;;; purposes. Optionally you can enable outline-mode in that buffer,
+;;; which is convenient but slows things down significantly.
+
+(defvar slime-log-events t
+  "*Log protocol events to the *slime-events* buffer.")
+
+(defvar slime-outline-mode-in-events-buffer nil
+  "*Non-nil means use outline-mode in *slime-events*.")
+
+(defvar slime-event-buffer-name "*slime-events*"
+  "The name of the slime event buffer.")
+
+(defun slime-log-event (event)
+  "Record the fact that EVENT occurred."
+  (when slime-log-events
+    (with-current-buffer (slime-events-buffer)
+      ;; trim?
+      (when (> (buffer-size) 100000)
+        (goto-char (/ (buffer-size) 2))
+        (re-search-forward "^(" nil t)
+        (delete-region (point-min) (point)))
+      (goto-char (point-max))
+      (save-excursion
+        (slime-pprint-event event (current-buffer)))
+      (when (and (boundp 'outline-minor-mode)
+                 outline-minor-mode)
+        (hide-entry))
+      (goto-char (point-max)))))
+
+(defun slime-pprint-event (event buffer)
+  "Pretty print EVENT in BUFFER with limited depth and width."
+  (let ((print-length 20)
+	(print-level 6)
+	(pp-escape-newlines t))
+    (pp event buffer)))
+
+(defun slime-events-buffer ()
+  (or (get-buffer slime-event-buffer-name)
+      (let ((buffer (get-buffer-create slime-event-buffer-name)))
+        (with-current-buffer buffer
+          (set (make-local-variable 'outline-regexp) "^(")
+          (set (make-local-variable 'comment-start) ";")
+          (set (make-local-variable 'comment-end) "")
+          (when slime-outline-mode-in-events-buffer
+            (outline-minor-mode)))
+        buffer)))
+
+
+;;;; Stream output
+
+(slime-def-connection-var slime-connection-output-buffer nil
+  "The buffer for the REPL.  May be nil or a dead buffer.")
+
+(make-variable-buffer-local
+ (defvar slime-output-start nil
+   "Marker for the start of the output for the evaluation."))
+
+(make-variable-buffer-local
+ (defvar slime-output-end nil
+   "Marker for end of output. New output is inserted at this mark."))
+
+;; dummy definitions for the compiler
+(defvar slime-repl-package-stack)
+(defvar slime-repl-directory-stack)
+(defvar slime-repl-input-start-mark)
+(defvar slime-repl-prompt-start-mark)
+
+
+(defun slime-output-buffer (&optional noprompt)
+  "Return the output buffer, create it if necessary."
+  (let ((buffer (slime-connection-output-buffer)))
+    (or (if (buffer-live-p buffer) buffer)
+        (setf (slime-connection-output-buffer)
+              (let ((connection (slime-connection)))
+                (with-current-buffer (slime-repl-buffer t connection)
+                  (unless (eq major-mode 'slime-repl-mode) 
+                    (slime-repl-mode))
+                  (setq slime-buffer-connection connection)
+                  (slime-reset-repl-markers)
+                  (unless noprompt 
+                    (slime-repl-insert-prompt))
+                  (current-buffer)))))))
+
+(defvar slime-repl-banner-function 'slime-repl-insert-banner)
+
+(defun slime-repl-update-banner ()
+  (funcall slime-repl-banner-function)
+  (goto-char (point-max))
+  (slime-mark-output-start)
+  (slime-mark-input-start)
+  (slime-repl-insert-prompt)
+  (pop-to-buffer (current-buffer)))
+
+(defun slime-repl-insert-banner ()
+  (when (zerop (buffer-size))
+    (let ((welcome (concat "; SLIME " (or (slime-changelog-date)
+                                          "- ChangeLog file not found"))))
+      (insert welcome))))
+
+(defun slime-init-output-buffer (connection)
+  (with-current-buffer (slime-output-buffer t)
+    (setq slime-buffer-connection connection
+          slime-repl-directory-stack '()
+          slime-repl-package-stack '())
+    (slime-repl-update-banner)))
+
+(defvar slime-show-last-output-function 
+  'slime-maybe-display-output-buffer
+  "*This function is called when a evaluation request is finished.
+It is called in the slime-output buffer and receives the region of the
+output as arguments.")
+
+(defun slime-show-last-output-region (start end)
+  (when (< start end)
+    (slime-display-buffer-region (current-buffer) (1- start)
+                                 slime-repl-input-start-mark)))
+
+(defun slime-maybe-display-output-buffer (start end)
+  (when (and (< start end)
+             (not (get-buffer-window (current-buffer) t)))
+    (display-buffer (current-buffer)))
+  (when (eobp)
+    (slime-repl-show-maximum-output t)))
+
+(defun slime-show-last-output ()
+  "Show the output from the last Lisp evaluation."
+  (with-current-buffer (slime-output-buffer)
+    (let ((start slime-output-start)
+          (end slime-output-end))
+      (funcall slime-show-last-output-function start end))))
+
+(defun slime-display-output-buffer ()
+  "Display the output buffer and scroll to bottom."
+  (with-current-buffer (slime-output-buffer)
+    (goto-char (point-max))
+    (unless (get-buffer-window (current-buffer) t)
+      (display-buffer (current-buffer) t))
+    (slime-repl-show-maximum-output)))
+
+(defmacro slime-with-output-end-mark (&rest body)
+  "Execute BODY at `slime-output-end'.  
+
+If point is initially at `slime-output-end' and the buffer is visible
+update window-point afterwards.  If point is initially not at
+`slime-output-end, execute body inside a `save-excursion' block."
+  `(let ((body.. (lambda () , at body))
+         (updatep.. (and (eobp) (pos-visible-in-window-p))))
+     (cond ((= (point) slime-output-end)
+            (let ((start.. (point)))
+              (funcall body..)
+              (set-marker slime-output-end (point))
+              (when (= start.. slime-repl-input-start-mark) 
+                (set-marker slime-repl-input-start-mark (point)))))
+           (t 
+            (save-excursion 
+              (goto-char slime-output-end)
+              (funcall body..))))
+     (when updatep..
+       (slime-repl-show-maximum-output 
+        (> (- slime-output-end slime-output-start) 1000)))))
+
+(defun slime-output-filter (process string)
+  (with-current-buffer (process-buffer process)
+    (when (and (plusp (length string))
+               (eq (process-status slime-buffer-connection) 'open))
+      (slime-write-string string))))
+
+(defvar slime-open-stream-hooks)
+
+(defun slime-open-stream-to-lisp (port)
+  (let ((stream (open-network-stream "*lisp-output-stream*" 
+                                     (slime-with-connection-buffer ()
+                                       (current-buffer))
+				     slime-lisp-host port)))
+    (slime-set-query-on-exit-flag stream)
+    (set-process-filter stream 'slime-output-filter)
+    (let ((pcs (process-coding-system (slime-current-connection))))
+      (set-process-coding-system stream (car pcs) (cdr pcs)))
+    (when-let (secret (slime-secret))
+      (slime-net-send secret stream))
+    (run-hook-with-args 'slime-open-stream-hooks stream)
+    stream))
+
+(defun slime-io-speed-test (&optional profile)
+  "A simple minded benchmark for stream performance.
+If a prefix argument is given, instrument the slime package for
+profiling before running the benchmark."
+  (interactive "P")
+  (eval-and-compile
+    (require 'elp))
+  (elp-reset-all)
+  (elp-restore-all)
+  (load "slime.el")
+  ;;(byte-compile-file "slime-net.el" t)
+  ;;(setq slime-log-events nil)
+  (setq slime-enable-evaluate-in-emacs t)
+  ;;(setq slime-repl-enable-presentations nil)
+  (when profile
+    (elp-instrument-package "slime-"))
+  (kill-buffer (slime-output-buffer))
+  ;;(display-buffer (slime-output-buffer))
+  (delete-other-windows)
+  (sit-for 0)
+  (slime-repl-send-string "(swank:io-speed-test 5000 1)")
+  (let ((proc (slime-inferior-process)))
+    (when proc
+      (switch-to-buffer (process-buffer proc))
+      (goto-char (point-max)))))
+
+(defvar slime-write-string-function 'slime-repl-write-string)
+
+(defun slime-write-string (string &optional target)
+  "Insert STRING in the REPL buffer or some other TARGET.
+If TARGET is nil, insert STRING as regular process
+output.  If TARGET is :repl-result, insert STRING as the result of the
+evaluation.  Other values of TARGET map to an Emacs marker via the 
+hashtable `slime-output-target-to-marker'; output is inserted at this marker."
+  (funcall slime-write-string-function string target))
+
+(defun slime-repl-write-string (string &optional target)
+  (case target
+    ((nil) (slime-repl-emit string))
+    (:repl-result (slime-repl-emit-result string))
+    (t (slime-emit-string string target))))
+
+(defun slime-repl-emit (string)
+  ;; insert the string STRING in the output buffer
+  (with-current-buffer (slime-output-buffer)
+    (slime-with-output-end-mark 
+     (slime-insert-propertized '(face slime-repl-output-face
+                                      rear-nonsticky (face))
+                               string)
+     (set-marker slime-output-end (point))
+     (when (and (= (point) slime-repl-prompt-start-mark)
+                (not (bolp)))
+       (insert "\n")
+       (set-marker slime-output-end (1- (point))))
+     (when (< slime-repl-input-start-mark (point))
+       (set-marker slime-repl-input-start-mark (point))))))
+
+(defun slime-repl-emit-result (string)
+  ;; insert STRING and mark it as evaluation result
+  (with-current-buffer (slime-output-buffer)
+    (goto-char slime-repl-input-start-mark)
+    (slime-insert-propertized `(face slime-repl-result-face
+                                     rear-nonsticky (face)) 
+                              string)
+    (set-marker slime-repl-input-start-mark (point))))
+
+(defvar slime-last-output-target-id 0
+  "The last integer we used as a TARGET id.")
+
+(defvar slime-output-target-to-marker
+  (make-hash-table)
+  "Map from TARGET ids to Emacs markers.
+The markers indicate where output should be inserted.")
+
+(defun slime-output-target-marker (target)
+  "Return the marker where output for TARGET should be inserted."
+  (case target
+    ((nil)
+     (with-current-buffer (slime-output-buffer)
+       slime-output-end))
+    (:repl-result
+     (with-current-buffer (slime-output-buffer)
+       slime-repl-input-start-mark))
+    (t
+     (gethash target slime-output-target-to-marker))))
+
+(defun slime-emit-string (string target)
+  "Insert STRING at target TARGET.
+See `slime-output-target-to-marker'."
+  (let* ((marker (slime-output-target-marker target))
+         (buffer (and marker (marker-buffer marker))))
+    (when buffer
+      (with-current-buffer buffer
+        (save-excursion 
+          ;; Insert STRING at MARKER, then move MARKER behind
+          ;; the insertion.
+          (goto-char marker)
+          (insert-before-markers string)
+          (set-marker marker (point)))))))
+
+(defun slime-switch-to-output-buffer (&optional connection)
+  "Select the output buffer, preferably in a different window."
+  (interactive (list (if prefix-arg (slime-choose-connection))))
+  (let ((slime-dispatching-connection (or connection 
+                                          slime-dispatching-connection)))
+    (set-buffer (slime-output-buffer))
+    (unless (eq (current-buffer) (window-buffer))
+      (pop-to-buffer (current-buffer) t))
+    (goto-char (point-max))))
+
+
+;;;; REPL
+;;
+;; The REPL uses some markers to separate input from output.  The
+;; usual configuration is as follows:
+;; 
+;;    ... output ...    ... result ...    prompt> ... input ...
+;;    ^            ^                      ^       ^           ^
+;;    output-start output-end  prompt-start       input-start input-end  
+;;
+;; output-start and input-start are right inserting markers;
+;; output-end and input-end left inserting.
+;;
+;; We maintain the following invariant:
+;;
+;;  output-start <= output-end <= input-start <= input-end.
+;;
+;; This invariant is important, because we must be prepared for
+;; asynchronous output and asynchronous reads.  ("Asynchronous" means,
+;; triggered by Lisp and not by Emacs.)
+;;
+;; All output is inserted at the output-end marker.  Some care must be
+;; taken when output-end and input-start are at the same position: if
+;; we blindly insert at that point, we break the invariant stated
+;; above, because the output-end marker is left inserting.  The macro
+;; `slime-with-output-end-mark' handles this complication by moving
+;; the input-start marker to an appropriate place.  The macro also
+;; updates window-point if necessary, and tries to keep the prompt in
+;; the first column by inserting a newline.
+;;
+;; A "synchronous" evaluation request proceeds as follows: the user
+;; inserts some text between input-start and input-end and then hits
+;; return.  We send the text between the input markers to Lisp, move
+;; the output and input makers to the line after the input and wait.
+;; When we receive the result, we insert it together with a prompt
+;; between the output-end and input-start mark.
+;; `slime-repl-insert-prompt' does this.
+;;
+;; It is possible that some output for such an evaluation request
+;; arrives after the result.  This output is inserted before the
+;; result (and before the prompt).  Output that doesn't belong the
+;; evaluation request should not be inserted before the result, but
+;; immediately before the prompt.  To achieve this, we move the
+;; output-end mark to prompt-start after a short delay (by starting a
+;; timer in `slime-repl-insert-prompt').  In summary: synchronous
+;; output should go before the result, asynchronous before the prompt.
+;;
+;; If we are in "reading" state, e.g., during a call to Y-OR-N-P,
+;; there is no prompt between output-end and input-start.
+;;
+
+;; Small helper.
+(defun slime-make-variables-buffer-local (&rest variables)
+  (mapcar #'make-variable-buffer-local variables))
+
+(slime-make-variables-buffer-local
+ (defvar slime-repl-package-stack nil
+   "The stack of packages visited in this repl.")
+
+ (defvar slime-repl-directory-stack nil
+   "The stack of default directories associated with this repl.")
+
+ (defvar slime-repl-prompt-start-mark)
+ (defvar slime-repl-input-start-mark)
+ (defvar slime-repl-input-end-mark)
+ (defvar slime-repl-last-input-start-mark)
+ (defvar slime-repl-old-input-counter 0
+   "Counter used to generate unique `slime-repl-old-input' properties.
+This property value must be unique to avoid having adjacent inputs be
+joined together."))
+
+(defun slime-reset-repl-markers ()
+  (dolist (markname '(slime-output-start
+                      slime-output-end
+                      slime-repl-prompt-start-mark
+                      slime-repl-input-start-mark
+                      slime-repl-input-end-mark
+                      slime-repl-last-input-start-mark))
+    (set markname (make-marker))
+    (set-marker (symbol-value markname) (point)))
+  ;; (set-marker-insertion-type slime-output-end t)
+  (set-marker-insertion-type slime-repl-input-end-mark t)
+  (set-marker-insertion-type slime-repl-prompt-start-mark t))
+
+;;;;; REPL mode setup
+
+(defvar slime-repl-mode-map)
+
+(setq slime-repl-mode-map (make-sparse-keymap))
+(set-keymap-parent slime-repl-mode-map lisp-mode-map)
+
+(dolist (spec slime-keys)
+  (destructuring-bind (key command &key inferior prefixed 
+                           &allow-other-keys) spec
+    (when inferior
+      (let ((key (if prefixed (concat slime-prefix-key key) key)))
+        (define-key slime-repl-mode-map key command)))))
+
+(slime-define-keys slime-repl-mode-map
+  ("\C-m" 'slime-repl-return)
+  ("\C-j" 'slime-repl-newline-and-indent)
+  ("\C-\M-m" 'slime-repl-closing-return)
+  ([(control return)] 'slime-repl-closing-return)
+  ("\C-a" 'slime-repl-bol)
+  ([home] 'slime-repl-bol)
+  ("\C-e" 'slime-repl-eol)
+  ("\M-p" 'slime-repl-previous-input)
+  ((kbd "C-<up>") 'slime-repl-backward-input)
+  ("\M-n" 'slime-repl-next-input)
+  ((kbd "C-<down>") 'slime-repl-forward-input)
+  ("\M-r" 'slime-repl-previous-matching-input)
+  ("\M-s" 'slime-repl-next-matching-input)
+  ("\C-c\C-c" 'slime-interrupt)
+  ("\C-c\C-b" 'slime-interrupt)
+  ("\C-c:"    'slime-interactive-eval)
+  ("\C-c\C-e" 'slime-interactive-eval)
+  ("\C-cE"     'slime-edit-value)
+  ;("\t"   'slime-complete-symbol)
+  ("\t"   'slime-indent-and-complete-symbol)
+  (" "    'slime-space)
+  ("\C-c\C-d" slime-doc-map)
+  ("\C-c\C-w" slime-who-map)
+  ("\C-\M-x" 'slime-eval-defun)
+  ("\C-c\C-o" 'slime-repl-clear-output)
+  ("\C-c\C-t" 'slime-repl-clear-buffer)
+  ("\C-c\C-u" 'slime-repl-kill-input)
+  ("\C-c\C-n" 'slime-repl-next-prompt)
+  ("\C-c\C-p" 'slime-repl-previous-prompt)
+  ("\C-c\C-l" 'slime-load-file)
+  ("\C-c\C-k" 'slime-compile-and-load-file)
+  ("\C-c\C-z" 'slime-nop))
+
+(defun slime-repl-mode () 
+  "Major mode for interacting with a superior Lisp.
+\\{slime-repl-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (setq major-mode 'slime-repl-mode)
+  (use-local-map slime-repl-mode-map)
+  (lisp-mode-variables t)
+  (set (make-local-variable 'lisp-indent-function)
+       'common-lisp-indent-function)
+  (setq font-lock-defaults nil)
+  (setq mode-name "REPL")
+  (setq slime-current-thread :repl-thread)
+  (set (make-local-variable 'scroll-conservatively) 20)
+  (set (make-local-variable 'scroll-margin) 0)
+  (slime-repl-safe-load-history)
+  (add-local-hook 'kill-buffer-hook 'slime-repl-safe-save-merged-history)
+  (add-hook 'kill-emacs-hook 'slime-repl-save-all-histories)
+  (slime-setup-command-hooks)
+  ;; At the REPL, we define beginning-of-defun and end-of-defun to be
+  ;; the start of the previous prompt or next prompt respectively.
+  ;; Notice the interplay with SLIME-REPL-BEGINNING-OF-DEFUN.
+  (set (make-local-variable 'beginning-of-defun-function) 
+       'slime-repl-mode-beginning-of-defun)
+  (set (make-local-variable 'end-of-defun-function) 
+       'slime-repl-mode-end-of-defun)
+  (run-hooks 'slime-repl-mode-hook))
+
+(defun slime-repl-buffer (&optional create connection)
+  "Get the REPL buffer for the current connection; optionally create."
+  (funcall (if create #'get-buffer-create #'get-buffer)
+           (format "*slime-repl %s*" (slime-connection-name connection))))
+
+(defun slime-repl ()
+  (interactive)
+  (slime-switch-to-output-buffer))
+
+(defun slime-repl-mode-beginning-of-defun ()
+  (slime-repl-previous-prompt)
+  t)
+
+(defun slime-repl-mode-end-of-defun ()
+  (slime-repl-next-prompt)
+  t)
+
+(defun slime-repl-send-string (string &optional command-string)
+  (cond (slime-repl-read-mode
+         (slime-repl-return-string string))
+        (t (slime-repl-eval-string string))))
+
+(defun slime-repl-eval-string (string)
+  (slime-rex ()
+      ((list 'swank:listener-eval string) (slime-lisp-package))
+    ((:ok result)
+     (slime-repl-insert-result result))
+    ((:abort)
+     (slime-repl-show-abort))))
+
+(defun slime-repl-insert-result (result)
+  (with-current-buffer (slime-output-buffer)
+    (goto-char (point-max))
+    (when result
+      (destructure-case result
+        ((:values &rest strings)
+         (unless (bolp) (insert "\n"))
+         (cond ((null strings)
+                (insert "; No value\n"))
+               (t
+                (dolist (string strings)
+                  (slime-propertize-region `(face slime-repl-result-face)
+                    (insert string))
+                  (insert "\n")))))))
+    (slime-repl-insert-prompt)))
+
+(defun slime-repl-show-abort ()
+  (with-current-buffer (slime-output-buffer)
+    (slime-with-output-end-mark 
+     (unless (bolp) (insert-before-markers "\n"))
+     (insert-before-markers "; Evaluation aborted.\n"))
+    (slime-repl-insert-prompt)))
+
+(defun slime-repl-insert-prompt ()
+  "Goto to point max, and insert the prompt."
+  (goto-char slime-repl-input-start-mark)
+  (assert (= slime-repl-input-end-mark (point-max)))
+  (unless (bolp) (insert "\n"))
+  (let ((prompt-start (point))
+        (prompt (format "%s> " (slime-lisp-package-prompt-string))))
+    (slime-propertize-region
+        '(face slime-repl-prompt-face read-only t intangible t
+               slime-repl-prompt t
+               ;; emacs stuff
+               rear-nonsticky (slime-repl-prompt read-only face intangible)
+               ;; xemacs stuff
+               start-open t end-open t)
+      (insert-before-markers prompt))
+    (slime-mark-input-start)
+    (set-marker slime-repl-input-end-mark (point-max))
+    (set-marker slime-repl-prompt-start-mark prompt-start)
+    (goto-char slime-repl-prompt-start-mark)
+    (slime-mark-output-start)
+    (goto-char (point-max)))
+  (slime-repl-show-maximum-output))
+
+(defun slime-repl-show-maximum-output (&optional force)
+  "Put the end of the buffer at the bottom of the window."
+  (assert (eobp))
+  (let ((win (get-buffer-window (current-buffer))))
+    (when win
+      (with-selected-window win
+        (recenter -1)))))
+
+(defvar slime-repl-current-input-hooks)
+
+(defun slime-repl-current-input (&optional until-point-p)
+  "Return the current input as string.
+The input is the region from after the last prompt to the end of
+buffer."
+  (or (run-hook-with-args-until-success 'slime-repl-current-input-hooks 
+                                        until-point-p)
+      (buffer-substring-no-properties
+       slime-repl-input-start-mark 
+       (if (and until-point-p (<= (point) slime-repl-input-end-mark))
+           (point)
+         slime-repl-input-end-mark))))
+
+(defun slime-property-position (text-property &optional object)
+  "Return the first position of TEXT-PROPERTY, or nil."
+  (if (get-text-property 0 text-property object)
+      0
+    (next-single-property-change 0 text-property object)))
+  
+(defun slime-mark-input-start ()
+  (set-marker slime-repl-last-input-start-mark
+              (marker-position slime-repl-input-start-mark))
+  (set-marker slime-repl-input-start-mark (point) (current-buffer))
+  (set-marker slime-repl-input-end-mark (point) (current-buffer)))
+
+(defun slime-mark-output-start (&optional position)
+  (let ((position (or position (point))))
+    (set-marker slime-output-start position)
+    (set-marker slime-output-end position)))
+
+(defun slime-mark-output-end ()
+  ;; Don't put slime-repl-output-face again; it would remove the
+  ;; special presentation face, for instance in the SBCL inspector.
+  (add-text-properties slime-output-start slime-output-end
+                       '(;;face slime-repl-output-face 
+                         rear-nonsticky (face))))
+
+(defun slime-repl-bol ()
+  "Go to the beginning of line or the prompt."
+  (interactive)
+  (cond ((and (>= (point) slime-repl-input-start-mark)
+              (slime-same-line-p (point) slime-repl-input-start-mark))
+         (goto-char slime-repl-input-start-mark))
+        (t (beginning-of-line 1)))
+  (slime-preserve-zmacs-region))
+
+(defun slime-repl-eol ()
+  "Go to the end of line or the prompt."
+  (interactive)
+  (if (and (<= (point) slime-repl-input-end-mark)
+           (slime-same-line-p (point) slime-repl-input-end-mark))
+      (goto-char slime-repl-input-end-mark)
+    (end-of-line 1))
+  (slime-preserve-zmacs-region))
+
+(defun slime-preserve-zmacs-region ()
+  "In XEmacs, ensure that the zmacs-region stays active after this command."
+  (when (boundp 'zmacs-region-stays)
+    (set 'zmacs-region-stays t)))
+
+(defun slime-repl-in-input-area-p ()
+   (and (<= slime-repl-input-start-mark (point))
+        (<= (point) slime-repl-input-end-mark)))
+
+(defun slime-repl-at-prompt-start-p ()
+  ;; This will not work on non-current prompts.
+  (= (point) slime-repl-input-start-mark))
+
+(defun slime-repl-beginning-of-defun ()
+  "Move to beginning of defun."
+  (interactive)
+  ;; We call BEGINNING-OF-DEFUN if we're at the start of a prompt
+  ;; already, to trigger SLIME-REPL-MODE-BEGINNING-OF-DEFUN by means
+  ;; of the locally bound BEGINNING-OF-DEFUN-FUNCTION, in order to
+  ;; jump to the start of the previous prompt.
+  (if (and (not (slime-repl-at-prompt-start-p))
+           (slime-repl-in-input-area-p))
+      (goto-char slime-repl-input-start-mark)
+    (beginning-of-defun))
+  t)
+
+(defun slime-repl-end-of-defun ()
+  "Move to next of defun."
+  (interactive)
+  ;; C.f. SLIME-REPL-BEGINNING-OF-DEFUN.
+  (if (and (not (= (point) slime-repl-input-end-mark)) 
+           (slime-repl-in-input-area-p))
+      (goto-char slime-repl-input-end-mark)
+    (end-of-defun))
+  t)
+
+;; FIXME: Shouldn't this be (= (point) slime-repl-input-end-mark)?
+(defun slime-repl-at-prompt-end-p ()
+  (and (get-char-property (max 1 (1- (point))) 'slime-repl-prompt)
+       (not (get-char-property (point) 'slime-repl-prompt))))
+ 
+(defun slime-repl-find-prompt (move)
+  (let ((origin (point)))
+    (loop (funcall move)
+          (when (or (slime-repl-at-prompt-end-p) (bobp) (eobp))
+            (return)))
+    (unless (slime-repl-at-prompt-end-p)
+      (goto-char origin))))
+
+(defun slime-search-property-change-fn (prop &optional backward)
+  (with-lexical-bindings (prop)
+    (if backward 
+        (lambda () 
+          (goto-char
+           (previous-single-char-property-change (point) prop)))
+        (lambda () 
+          (goto-char
+           (next-single-char-property-change (point) prop))))))
+
+(defun slime-repl-previous-prompt ()
+  "Move backward to the previous prompt."
+  (interactive)
+  (slime-repl-find-prompt 
+   (slime-search-property-change-fn 'slime-repl-prompt t)))
+
+(defun slime-repl-next-prompt ()
+  "Move forward to the next prompt."
+  (interactive)
+  (slime-repl-find-prompt
+   (slime-search-property-change-fn 'slime-repl-prompt)))
+
+(defvar slime-repl-return-hooks)
+
+(defun slime-repl-return (&optional end-of-input)
+  "Evaluate the current input string, or insert a newline.  
+Send the current input ony if a whole expression has been entered,
+i.e. the parenthesis are matched. 
+
+With prefix argument send the input even if the parenthesis are not
+balanced."
+  (interactive "P")
+  (slime-check-connected)
+  (assert (<= (point) slime-repl-input-end-mark))
+  (cond (end-of-input
+         (slime-repl-send-input))
+        (slime-repl-read-mode ; bad style?
+         (slime-repl-send-input t))
+        ((and (get-text-property (point) 'slime-repl-old-input)
+              (< (point) slime-repl-input-start-mark))
+         (slime-repl-grab-old-input end-of-input)
+         (slime-repl-recenter-if-needed))
+        ((run-hook-with-args-until-success 'slime-repl-return-hooks))
+        ((slime-input-complete-p slime-repl-input-start-mark
+                                 (ecase slime-repl-return-behaviour
+                                   (:send-only-if-after-complete (min (point) slime-repl-input-end-mark))
+                                   (:send-if-complete slime-repl-input-end-mark)))
+         (slime-repl-send-input t))
+        (t 
+         (slime-repl-newline-and-indent)
+         (message "[input not complete]"))))
+
+(defun slime-repl-recenter-if-needed ()
+  "Make sure that slime-repl-input-end-mark is visible."
+  (unless (pos-visible-in-window-p slime-repl-input-end-mark)
+    (save-excursion
+      (goto-char slime-repl-input-end-mark)
+      (recenter -1))))
+
+(defun slime-repl-send-input (&optional newline)
+  "Goto to the end of the input and send the current input.
+If NEWLINE is true then add a newline at the end of the input."
+  (when (< (point) slime-repl-input-start-mark)
+    (error "No input at point."))
+  (goto-char slime-repl-input-end-mark)
+  (let ((end (point))) ; end of input, without the newline
+    (slime-repl-add-to-input-history 
+     (buffer-substring slime-repl-input-start-mark end))
+    (when newline 
+      (insert "\n")
+      (slime-repl-show-maximum-output))
+    (let ((inhibit-read-only t))
+      (add-text-properties slime-repl-input-start-mark 
+                           (point)
+                           `(slime-repl-old-input
+                             ,(incf slime-repl-old-input-counter))))
+    (let ((overlay (make-overlay slime-repl-input-start-mark end)))
+      ;; These properties are on an overlay so that they won't be taken
+      ;; by kill/yank.
+      (overlay-put overlay 'read-only t)
+      (overlay-put overlay 'face 'slime-repl-input-face)))
+  (let ((input (slime-repl-current-input)))
+    (goto-char slime-repl-input-end-mark)
+    (slime-mark-input-start)
+    (slime-mark-output-start)
+    (slime-repl-send-string input)))
+
+(defun slime-repl-grab-old-input (replace)
+  "Resend the old REPL input at point.  
+If replace is non-nil the current input is replaced with the old
+input; otherwise the new input is appended.  The old input has the
+text property `slime-repl-old-input'."
+  (multiple-value-bind (beg end) (slime-property-bounds 'slime-repl-old-input)
+    (let ((old-input (buffer-substring beg end)) ;;preserve
+          ;;properties, they will be removed later
+          (offset (- (point) beg)))
+      ;; Append the old input or replace the current input
+      (cond (replace (goto-char slime-repl-input-start-mark))
+            (t (goto-char slime-repl-input-end-mark)
+               (unless (eq (char-before) ?\ )
+                 (insert " "))))
+      (delete-region (point) slime-repl-input-end-mark)
+      (save-excursion (insert old-input))
+      (forward-char offset))))
+
+(defun slime-property-bounds (prop)
+  "Return two the positions of the previous and next changes to PROP.
+PROP is the name of a text property."
+  (let* ((beg (save-excursion
+                ;; previous-single-char-property-change searches for a
+                ;; property change from the previous character, but we
+                ;; want to look for a change from the point. We step
+                ;; forward one char to avoid doing the wrong thing if
+                ;; we're at the beginning of the old input. -luke
+                ;; (18/Jun/2004)
+                (unless (not (get-text-property (point) prop)) 
+                  ;; alanr unless we are sitting right after it May 19, 2005
+                  (ignore-errors (forward-char)))
+                (previous-single-char-property-change (point) prop)))
+         (end (save-excursion
+                (if (get-text-property (point) prop)
+                    (progn (goto-char (next-single-char-property-change 
+                                       (point) prop))
+                           (skip-chars-backward "\n \t\r" beg)
+                           (point))
+                  (point)))))
+    (values beg end)))
+
+(defun slime-repl-closing-return ()
+  "Evaluate the current input string after closing all open lists."
+  (interactive)
+  (goto-char (point-max))
+  (save-restriction
+    (narrow-to-region slime-repl-input-start-mark (point))
+    (while (ignore-errors (save-excursion (backward-up-list 1)) t)
+      (insert ")")))
+  (slime-repl-return))
+
+(defun slime-repl-newline-and-indent ()
+  "Insert a newline, then indent the next line.
+Restrict the buffer from the prompt for indentation, to avoid being
+confused by strange characters (like unmatched quotes) appearing
+earlier in the buffer."
+  (interactive)
+  (save-restriction
+    (narrow-to-region slime-repl-prompt-start-mark (point-max))
+    (insert "\n")
+    (lisp-indent-line)))
+
+(defun slime-repl-delete-current-input ()
+  (delete-region slime-repl-input-start-mark slime-repl-input-end-mark))
+
+(defun slime-repl-kill-input ()
+  "Kill all text from the prompt to point."
+  (interactive)
+  (cond ((< (marker-position slime-repl-input-start-mark) (point))
+         (kill-region slime-repl-input-start-mark (point)))
+        ((= (point) (marker-position slime-repl-input-start-mark))
+         (slime-repl-delete-current-input))))
+
+(defun slime-repl-replace-input (string)
+  (slime-repl-delete-current-input)
+  (insert-and-inherit string))
+
+(defun slime-repl-input-line-beginning-position ()
+  (save-excursion
+    (goto-char slime-repl-input-start-mark)
+    (line-beginning-position)))
+
+(defvar slime-repl-clear-buffer-hook)
+
+(defun slime-repl-clear-buffer ()
+  "Delete the output generated by the Lisp process."
+  (interactive)
+  (set-marker slime-repl-last-input-start-mark nil)
+  (let ((inhibit-read-only t))
+    (delete-region (point-min) (slime-repl-input-line-beginning-position))
+    (goto-char slime-repl-input-start-mark))
+  (run-hooks 'slime-repl-clear-buffer-hook))
+
+(defun slime-repl-clear-output ()
+  "Delete the output inserted since the last input."
+  (interactive)
+  (let ((start (save-excursion 
+                 (slime-repl-previous-prompt)
+                 (ignore-errors (forward-sexp))
+                 (forward-line)
+                 (point)))
+        (end (1- (slime-repl-input-line-beginning-position))))
+    (when (< start end)
+      (let ((inhibit-read-only t))
+        (delete-region start end)
+        (save-excursion
+          (goto-char start)
+          (insert ";;; output flushed"))))))
+
+(defun slime-indent-and-complete-symbol ()
+  "Indent the current line and perform symbol completion.
+First indent the line. If indenting doesn't move point, complete
+the symbol. If there's no symbol at the point, show the arglist
+for the most recently enclosed macro or function."
+  (interactive)
+  (let ((pos (point)))
+    (unless (get-text-property (line-beginning-position) 'slime-repl-prompt)
+      (lisp-indent-line))
+    (when (= pos (point))
+      (cond ((save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t))
+             (slime-complete-symbol))
+            ((memq (char-before) '(?\t ?\ ))
+             (slime-echo-arglist))))))
+
+(defun slime-repl-set-package (package)
+  "Set the package of the REPL buffer to PACKAGE."
+  (interactive (list (slime-read-package-name "Package: " 
+					      (slime-find-buffer-package))))
+  (with-current-buffer (slime-output-buffer)
+    (let ((unfinished-input (slime-repl-current-input)))
+      (destructuring-bind (name prompt-string)
+          (slime-eval `(swank:set-package ,package))
+        (setf (slime-lisp-package) name)
+        (setf (slime-lisp-package-prompt-string) prompt-string)
+        (slime-repl-insert-prompt)
+        (insert unfinished-input)))))
+
+
+;;;;; History
+
+(defcustom slime-repl-wrap-history nil
+  "*T to wrap history around when the end is reached."
+  :type 'boolean
+  :group 'slime-repl)
+
+(make-variable-buffer-local
+ (defvar slime-repl-input-history '()
+   "History list of strings read from the REPL buffer."))
+
+(defun slime-repl-add-to-input-history (string)
+  "Add STRING to the input history.
+Empty strings and duplicates are ignored."
+  (unless (or (equal string "")
+              (equal string (car slime-repl-input-history)))
+    (push string slime-repl-input-history)))
+
+;; These two vars contain the state of the last history search.  We
+;; only use them if `last-command' was 'slime-repl-history-replace,
+;; otherwise we reinitialize them.
+
+(defvar slime-repl-input-history-position -1
+  "Newer items have smaller indices.")
+
+(defvar slime-repl-history-pattern nil
+  "The regexp most recently used for finding input history.")
+
+(defun slime-repl-history-replace (direction &optional regexp delete-at-end-p)
+  "Replace the current input with the next line in DIRECTION.
+DIRECTION is 'forward' or 'backward' (in the history list).
+If REGEXP is non-nil, only lines matching REGEXP are considered.
+If DELETE-AT-END-P is non-nil then remove the string if the end of the
+history is reached."
+  (setq slime-repl-history-pattern regexp)
+  (let* ((min-pos -1)
+         (max-pos (length slime-repl-input-history))
+         (pos0 (cond ((slime-repl-history-search-in-progress-p)
+                      slime-repl-input-history-position)
+                     (t min-pos)))
+         (pos (slime-repl-position-in-history pos0 direction (or regexp "")))
+         (msg nil))
+    (cond ((and (< min-pos pos) (< pos max-pos))
+           (slime-repl-replace-input (nth pos slime-repl-input-history))
+           (setq msg (format "History item: %d" pos)))
+          ((not slime-repl-wrap-history)
+           (setq msg (cond ((= pos min-pos) "End of history")
+                           ((= pos max-pos) "Beginning of history"))))
+          (slime-repl-wrap-history
+           (setq pos (if (= pos min-pos) max-pos min-pos))
+           (setq msg "Wrapped history")))
+    (when (or (<= pos min-pos) (<= max-pos pos))
+      (when regexp
+        (setq msg (concat msg "; no matching item")))
+      (when delete-at-end-p
+        (slime-repl-replace-input "")))
+    ;;(message "%s [%d %d %s]" msg start-pos pos regexp)
+    (message "%s%s" msg (cond ((not regexp) "")
+                              (t (format "; current regexp: %s" regexp))))
+    (setq slime-repl-input-history-position pos)
+    (setq this-command 'slime-repl-history-replace)))
+
+(defun slime-repl-history-search-in-progress-p ()
+  (eq last-command 'slime-repl-history-replace))
+
+(defun slime-repl-terminate-history-search ()
+  (setq last-command this-command))
+
+(defun slime-repl-position-in-history (start-pos direction regexp)
+  "Return the position of the history item matching regexp.
+Return -1 resp. the length of the history if no item matches"
+  ;; Loop through the history list looking for a matching line
+  (let* ((step (ecase direction
+                 (forward -1)
+                 (backward 1)))
+         (history slime-repl-input-history)
+         (len (length history)))
+    (loop for pos = (+ start-pos step) then (+ pos step)
+          if (< pos 0) return -1
+          if (<= len pos) return len
+          if (string-match regexp (nth pos history)) return pos)))
+
+(defun slime-repl-previous-input ()
+  "Cycle backwards through input history.
+If the `last-command' was a history navigation command use the
+same search pattern for this command.
+Otherwise use the current input as search pattern."
+  (interactive)
+  (slime-repl-history-replace 'backward (slime-repl-history-pattern t) t))
+
+(defun slime-repl-next-input ()
+  "Cycle forwards through input history.
+See `slime-repl-previous-input'."
+  (interactive)
+  (slime-repl-history-replace 'forward (slime-repl-history-pattern t) t))
+
+(defun slime-repl-forward-input ()
+  "Cycle forwards through input history."
+  (interactive)
+  (slime-repl-history-replace 'forward (slime-repl-history-pattern) t))
+
+(defun slime-repl-backward-input ()
+  "Cycle backwards through input history."
+  (interactive)
+  (slime-repl-history-replace 'backward (slime-repl-history-pattern) t))
+
+(defun slime-repl-previous-matching-input (regexp)
+  (interactive "sPrevious element matching (regexp): ")
+  (slime-repl-terminate-history-search)
+  (slime-repl-history-replace 'backward regexp))
+
+(defun slime-repl-next-matching-input (regexp)
+  (interactive "sNext element matching (regexp): ")
+  (slime-repl-terminate-history-search)
+  (slime-repl-history-replace 'forward regexp))
+
+(defun slime-repl-history-pattern (&optional use-current-input)
+  "Return the regexp for the navigation commands."
+  (cond ((slime-repl-history-search-in-progress-p)
+         slime-repl-history-pattern)
+        (use-current-input
+         (let ((str (slime-repl-current-input)))
+           (cond ((string-match "^[ \n]*$" str) nil)
+                 (t (concat "^" (regexp-quote str))))))
+        (t nil)))
+
+(defun slime-repl-delete-from-input-history (string)
+  "Delete STRING from the repl input history. 
+
+When string is not provided then clear the current repl input and
+use it as an input.  This is useful to get rid of unwanted repl
+history entries while navigating the repl history."
+  (interactive (list (slime-repl-current-input)))
+  (let ((merged-history 
+         (slime-repl-merge-histories slime-repl-input-history
+                                     (slime-repl-read-history nil t))))
+    (setq slime-repl-input-history
+          (delete* string merged-history :test #'string=))
+    (slime-repl-save-history))
+  (slime-repl-delete-current-input))
+
+;;;;; Persistent History 
+
+(defun slime-repl-merge-histories (old-hist new-hist)
+  "Merge entries from OLD-HIST and NEW-HIST."
+  ;; Newer items in each list are at the beginning.
+  (let* ((ht (make-hash-table :test #'equal))
+         (test (lambda (entry)
+                 (or (gethash entry ht)
+                     (progn (setf (gethash entry ht) t)
+                            nil)))))
+    (append (remove-if test new-hist)
+            (remove-if test old-hist))))
+
+(defun slime-repl-load-history (&optional filename)
+  "Set the current SLIME REPL history.
+It can be read either from FILENAME or `slime-repl-history-file' or
+from a user defined filename."
+  (interactive (list (slime-repl-read-history-filename)))
+  (let ((file (or filename slime-repl-history-file)))
+    (setq slime-repl-input-history (slime-repl-read-history file t))))
+
+(defun slime-repl-read-history (&optional filename noerrer)
+  "Read and return the history from FILENAME.  
+The default value for FILENAME is `slime-repl-history-file'.
+If NOERROR is true return and the file doesn't exits return nil."
+  (let ((file (or filename slime-repl-history-file)))
+    (cond ((not (file-readable-p file)) '())
+          (t (with-temp-buffer
+               (insert-file-contents file)
+               (read (current-buffer)))))))
+
+(defun slime-repl-read-history-filename ()
+  (read-file-name "Use SLIME REPL history from file: " 
+                  slime-repl-history-file))
+
+(defun slime-repl-save-merged-history (&optional filename)
+  "Read the history file, merge the current REPL history and save it.
+This tries to be smart in merging the history from the file and the
+current history in that it tries to detect the unique entries using
+`slime-repl-merge-histories'."
+  (interactive (list (slime-repl-read-history-filename)))
+  (let ((file (or filename slime-repl-history-file)))
+    (with-temp-message "saving history..."
+      (let ((hist (slime-repl-merge-histories (slime-repl-read-history file t)
+                                              slime-repl-input-history)))
+        (slime-repl-save-history file hist)))))
+
+(defun slime-repl-save-history (&optional filename history)
+  "Simply save the current SLIME REPL history to a file.
+When SLIME is setup to always load the old history and one uses only
+one instance of slime all the time, there is no need to merge the
+files and this function is sufficient.
+
+When the list is longer than `slime-repl-history-size' it will be
+truncated.  That part is untested, though!"
+  (interactive (list (slime-repl-read-history-filename)))
+  (let ((file (or filename slime-repl-history-file))
+        (hist (or history slime-repl-input-history)))
+    (unless (file-writable-p file)
+      (error (format "History file not writable: %s" file)))
+    (let ((hist (subseq hist 0 (min (length hist) slime-repl-history-size))))
+      ;;(message "saving %s to %s\n" hist file)
+      (with-temp-file file
+        (let ((cs slime-repl-history-file-coding-system)
+              (print-length nil) (print-level nil))
+          (setq buffer-file-coding-system cs)
+          (insert (format ";; -*- coding: %s -*-\n" cs))
+          (insert ";; History for SLIME REPL. Automatically written.\n"
+                  ";; Edit only if you know what you're doing\n")
+          (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))))
+
+(defun slime-repl-save-all-histories ()
+  "Save the history in each repl buffer."
+  (dolist (b (buffer-list))
+    (with-current-buffer b
+      (when (eq major-mode 'slime-repl-mode)
+        (slime-repl-safe-save-merged-history)))))
+
+(defun slime-repl-safe-save-merged-history ()
+  (slime-repl-call-with-handler 
+   #'slime-repl-save-merged-history
+   "%S while saving the history. Continue? "))
+
+(defun slime-repl-safe-load-history ()
+  (slime-repl-call-with-handler 
+   #'slime-repl-load-history
+   "%S while loading the history. Continue? "))
+
+(defun slime-repl-call-with-handler (fun query)
+  "Call FUN in the context of an error handler.
+The handler will use qeuery to ask the use if the error should be ingored."
+  (condition-case err
+      (funcall fun)
+    (error 
+     (if (y-or-n-p (format query (error-message-string err)))
+         nil
+       (signal (car err) (cdr err))))))
+
+
+;;;;; REPL Read Mode
+
+(define-key slime-repl-mode-map
+  (string slime-repl-shortcut-dispatch-char) 'slime-handle-repl-shortcut)
+
+(define-minor-mode slime-repl-read-mode 
+  "Mode the read input from Emacs
+\\{slime-repl-read-mode-map}"
+  nil
+  "[read]"
+  '(("\C-m" . slime-repl-return)
+    ("\C-c\C-b" . slime-repl-read-break)
+    ("\C-c\C-c" . slime-repl-read-break)))
+
+(make-variable-buffer-local
+ (defvar slime-read-string-threads nil))
+
+(make-variable-buffer-local
+ (defvar slime-read-string-tags nil))
+
+(defun slime-repl-read-string (thread tag)
+  (slime-switch-to-output-buffer)
+  (push thread slime-read-string-threads)
+  (push tag slime-read-string-tags)
+  (goto-char (point-max))
+  (slime-mark-output-end)
+  (slime-mark-input-start)
+  (slime-repl-read-mode 1))
+
+(defun slime-y-or-n-p (thread tag question)
+  (slime-dispatch-event `(:emacs-return ,thread ,tag ,(y-or-n-p question))))
+
+(defun slime-repl-return-string (string)
+  (slime-dispatch-event `(:emacs-return-string 
+                          ,(pop slime-read-string-threads)
+                          ,(pop slime-read-string-tags)
+                          ,string))
+  (slime-repl-read-mode -1))
+
+(defun slime-repl-read-break ()
+  (interactive)
+  (slime-dispatch-event `(:emacs-interrupt ,(car slime-read-string-threads))))
+
+(defun slime-repl-abort-read (thread tag)
+  (with-current-buffer (slime-output-buffer)
+    (pop slime-read-string-threads)
+    (pop slime-read-string-tags)
+    (slime-repl-read-mode -1)
+    (message "Read aborted")))
+
+
+;;;;; REPL handlers
+
+(defstruct (slime-repl-shortcut (:conc-name slime-repl-shortcut.))
+  symbol names handler one-liner)
+
+(defvar slime-repl-shortcut-table nil
+  "A list of slime-repl-shortcuts")
+
+(defvar slime-repl-shortcut-history '()
+  "History list of shortcut command names.")
+
+(defun slime-handle-repl-shortcut ()
+  (interactive)
+  (if (> (point) slime-repl-input-start-mark)
+      (insert (string slime-repl-shortcut-dispatch-char))
+      (let ((shortcut (slime-lookup-shortcut
+                       (completing-read "Command: " 
+                                        (slime-bogus-completion-alist
+                                         (slime-list-all-repl-shortcuts))
+                                        nil t nil
+                                        'slime-repl-shortcut-history))))
+        (call-interactively (slime-repl-shortcut.handler shortcut)))))
+
+(defun slime-list-all-repl-shortcuts ()
+  (loop for shortcut in slime-repl-shortcut-table
+        append (slime-repl-shortcut.names shortcut)))
+
+(defun slime-lookup-shortcut (name)
+  (find-if (lambda (s) (member name (slime-repl-shortcut.names s)))
+           slime-repl-shortcut-table))
+
+(defmacro defslime-repl-shortcut (elisp-name names &rest options)
+  "Define a new repl shortcut. ELISP-NAME is a symbol specifying
+  the name of the interactive function to create, or NIL if no
+  function should be created. NAMES is a list of (full-name .
+  aliases). OPTIONS is an olist specifying the handler and the
+  help text."
+  `(progn
+     ,(when elisp-name
+        `(defun ,elisp-name ()
+           (interactive)
+           (call-interactively ,(second (assoc :handler options)))))
+     (let ((new-shortcut (make-slime-repl-shortcut
+                          :symbol ',elisp-name
+                          :names (list , at names)
+                          ,@(apply #'append options))))
+       (setq slime-repl-shortcut-table
+             (remove-if (lambda (s)
+                          (member ',(car names) (slime-repl-shortcut.names s)))
+                        slime-repl-shortcut-table))
+       (push new-shortcut slime-repl-shortcut-table)
+       ',elisp-name)))
+
+(defun slime-list-repl-short-cuts ()
+  (interactive)
+  (slime-with-output-to-temp-buffer ("*slime-repl-help*") nil
+    (let ((table (sort* (copy-list slime-repl-shortcut-table) #'string<
+                        :key (lambda (x) 
+                               (car (slime-repl-shortcut.names x))))))
+      (dolist (shortcut table)
+        (let ((names (slime-repl-shortcut.names shortcut)))
+          (insert (pop names)) ;; first print the "full" name
+          (when names
+            ;; we also have aliases
+            (insert " (aka ")
+            (while (cdr names)
+              (insert (pop names) ", "))
+            (insert (car names) ")"))
+        (insert "\n     " (slime-repl-shortcut.one-liner shortcut)
+                "\n"))))))
+
+(defun slime-save-some-lisp-buffers ()
+  (if slime-repl-only-save-lisp-buffers
+      (save-some-buffers nil (lambda ()
+                               (and (memq major-mode slime-lisp-modes)
+                                    (not (null buffer-file-name)))))
+      (save-some-buffers)))
+  
+(defslime-repl-shortcut slime-repl-shortcut-help ("help" "?")
+  (:handler 'slime-list-repl-short-cuts)
+  (:one-liner "Display the help."))
+
+(defslime-repl-shortcut nil ("change-directory" "!d" "cd")
+  (:handler 'slime-set-default-directory)
+  (:one-liner "Change the current directory."))
+
+(defslime-repl-shortcut nil ("pwd")
+  (:handler (lambda () 
+              (interactive)
+              (let ((dir (slime-eval `(swank:default-directory))))
+                (message "Directory %s" dir))))
+  (:one-liner "Show the current directory."))
+
+(defslime-repl-shortcut slime-repl-push-directory
+    ("push-directory" "+d" "pushd")
+  (:handler (lambda (directory)
+              (interactive
+               (list (read-directory-name
+                      "Push directory: "
+                      (slime-eval '(swank:default-directory))
+                      nil nil "")))
+              (push (slime-eval '(swank:default-directory))
+                    slime-repl-directory-stack)
+              (slime-set-default-directory directory)))
+  (:one-liner "Save the current directory and set it to a new one."))
+
+(defslime-repl-shortcut slime-repl-pop-directory
+    ("pop-directory" "-d" "popd")
+  (:handler (lambda ()
+              (interactive)
+              (if (null slime-repl-directory-stack)
+                  (message "Directory stack is empty.")
+                  (slime-set-default-directory
+                   (pop slime-repl-directory-stack)))))
+  (:one-liner "Restore the last saved directory."))
+
+(defslime-repl-shortcut nil ("change-package" "!p" "in-package" "in")
+  (:handler 'slime-repl-set-package)
+  (:one-liner "Change the current package."))
+
+(defslime-repl-shortcut slime-repl-push-package ("push-package" "+p")
+  (:handler (lambda (package)
+              (interactive (list (slime-read-package-name "Package: ")))
+              (push (slime-lisp-package) slime-repl-package-stack)
+              (slime-repl-set-package package)))
+  (:one-liner "Save the current package and set it to a new one."))
+
+(defslime-repl-shortcut slime-repl-pop-package ("pop-package" "-p")
+  (:handler (lambda ()
+              (interactive)
+              (if (null slime-repl-package-stack)
+                  (message "Package stack is empty.")
+                  (slime-repl-set-package
+                   (pop slime-repl-package-stack)))))
+  (:one-liner "Restore the last saved package."))
+
+(defslime-repl-shortcut slime-repl-resend ("resend-form")
+  (:handler (lambda ()
+              (interactive)
+              (insert (car slime-repl-input-history))
+              (insert "\n")
+              (slime-repl-send-input)))
+  (:one-liner "Resend the last form."))
+
+(defslime-repl-shortcut slime-repl-disconnect ("disconnect")
+  (:handler 'slime-disconnect)
+  (:one-liner "Disconnect all connections."))
+
+(defslime-repl-shortcut slime-repl-sayoonara ("sayoonara")
+  (:handler (lambda ()
+              (interactive)
+              (when (slime-connected-p)
+                (slime-quit-lisp))
+              (slime-kill-all-buffers)))
+  (:one-liner "Quit all Lisps and close all SLIME buffers."))
+
+(defslime-repl-shortcut slime-repl-quit ("quit")
+  (:handler 'slime-quit-lisp)
+  (:one-liner "Quit the current Lisp."))
+
+(defslime-repl-shortcut slime-repl-defparameter ("defparameter" "!")
+  (:handler (lambda (name value)
+              (interactive (list (slime-read-symbol-name "Name (symbol): " t)
+                                 (slime-read-from-minibuffer "Value: " "*")))
+              (insert "(cl:defparameter " name " " value 
+                      " \"REPL generated global variable.\")")
+              (slime-repl-send-input t)))
+  (:one-liner "Define a new global, special, variable."))
+
+(defslime-repl-shortcut slime-repl-compile-and-load ("compile-and-load" "cl")
+  (:handler (lambda (filename)
+              (interactive (list (expand-file-name
+                                  (read-file-name "File: " nil nil nil nil))))
+              (slime-save-some-lisp-buffers)
+              (slime-eval-async 
+               `(swank:compile-file-if-needed 
+                 ,(slime-to-lisp-filename filename) t)
+               (slime-make-compilation-finished-continuation (current-buffer)))))
+  (:one-liner "Compile (if neccessary) and load a lisp file."))
+
+(defslime-repl-shortcut nil  ("restart-inferior-lisp")
+  (:handler 'slime-restart-inferior-lisp)
+  (:one-liner "Restart *inferior-lisp* and reconnect SLIME."))
+
+(defun slime-restart-inferior-lisp ()
+  (interactive)
+  (assert (slime-inferior-process) () "No inferior lisp process")
+  (slime-eval-async '(swank:quit-lisp))
+  (set-process-filter (slime-connection) nil)
+  (set-process-sentinel (slime-connection) 'slime-restart-sentinel))
+  
+(defun slime-restart-sentinel (process message)
+  "Restart the inferior lisp process.
+Also rearrange windows."
+  (assert (process-status process) 'closed)
+  (let* ((proc (slime-inferior-process process))
+         (args (slime-inferior-lisp-args proc))
+         (buffer (buffer-name (process-buffer proc)))
+         (buffer-window (get-buffer-window buffer))
+         (new-proc (slime-start-lisp (plist-get args :program)
+                                     (plist-get args :program-args)
+                                     nil
+                                     buffer))
+         (repl-buffer (slime-repl-buffer nil process))
+         (repl-window (and repl-buffer (get-buffer-window repl-buffer))))
+    (slime-net-close process)
+    (slime-inferior-connect new-proc args)
+    (cond ((and repl-window (not buffer-window))
+           (set-window-buffer repl-window buffer)
+           (select-window repl-window))
+          (repl-window
+           (select-window repl-window))
+          (t 
+           (pop-to-buffer buffer)))
+    (switch-to-buffer buffer)
+    (goto-char (point-max))))
+
+
+;;;;; Cleanup after a quit
+
+(defun slime-kill-all-buffers ()
+  "Kill all the slime related buffers. This is only used by the
+  repl command sayoonara."
+  (dolist (buf (buffer-list))
+    (when (or (string= (buffer-name buf) slime-event-buffer-name)
+              (string-match "^\\*inferior-lisp*" (buffer-name buf))
+              (string-match "^\\*slime-repl .*\\*$" (buffer-name buf))
+              (string-match "^\\*sldb .*\\*$" (buffer-name buf))
+              (string-match "^\\*SLIME.*\\*$" (buffer-name buf)))
+      (kill-buffer buf))))
+
+
+;;;; Compilation and the creation of compiler-note annotations
+
+(defvar slime-highlight-compiler-notes t
+  "*When non-nil annotate buffers with compilation notes etc.")
+
+(defcustom slime-display-compilation-output t
+  "Display the REPL buffer before compiling files."
+  :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+  :group 'slime-mode)
+
+(defvar slime-before-compile-functions nil
+  "A list of function called before compiling a buffer or region.
+The function receive two arguments: the beginning and the end of the 
+region that will be compiled.")
+
+(defcustom slime-compilation-finished-hook 'slime-maybe-list-compiler-notes
+  "Hook called with a list of compiler notes after a compilation."
+  :group 'slime-mode
+  :type 'hook
+  :options '(slime-maybe-list-compiler-notes
+             slime-list-compiler-notes
+             slime-maybe-show-xrefs-for-notes))
+
+(defcustom slime-goto-first-note-after-compilation nil
+  "When T next-note will always goto to the first note in a
+final, no matter where the point is."
+  :group 'slime-mode
+  :type 'boolean)
+
+(defun slime-compile-and-load-file ()
+  "Compile and load the buffer's file and highlight compiler notes.
+
+Each source location that is the subject of a compiler note is
+underlined and annotated with the relevant information. The commands
+`slime-next-note' and `slime-previous-note' can be used to navigate
+between compiler notes and to display their full details."
+  (interactive)
+  (slime-compile-file t))
+
+(defun slime-compile-file (&optional load)
+  "Compile current buffer's file and highlight resulting compiler notes.
+
+See `slime-compile-and-load-file' for further details."
+  (interactive)
+  ;;(unless (memq major-mode slime-lisp-modes)
+  ;;  (error "Only valid in lisp-mode"))
+  (check-parens)
+  (unless buffer-file-name
+    (error "Buffer %s is not associated with a file." (buffer-name)))
+  (when (and (buffer-modified-p)
+             (y-or-n-p (format "Save file %s? " (buffer-file-name))))
+    (save-buffer))
+  (run-hook-with-args 'slime-before-compile-functions (point-min) (point-max))
+  (let ((file (slime-to-lisp-filename (buffer-file-name))))
+    (slime-insert-transcript-delimiter (format "Compile file %s" file))
+    (when slime-display-compilation-output
+      (slime-display-output-buffer))
+    (slime-eval-async 
+     `(swank:compile-file-for-emacs ,file ,(if load t nil))
+     (slime-rcurry #'slime-compilation-finished (current-buffer)))
+    (message "Compiling %s..." file)))
+
+(defun slime-compile-defun ()
+  "Compile the current toplevel form."
+  (interactive)
+  (apply #'slime-compile-region (slime-region-for-defun-at-point)))
+
+(defun slime-compile-region (start end)
+  "Compile the region."
+  (interactive "r")
+  (run-hook-with-args 'slime-before-compile-functions start end)
+  (slime-compile-string (buffer-substring-no-properties start end) start))
+
+(defun slime-compile-string (string start-offset)
+  (slime-eval-async 
+   `(swank:compile-string-for-emacs
+     ,string
+     ,(buffer-name)
+     ,start-offset
+     ,(if (buffer-file-name) (file-name-directory (buffer-file-name))))
+   (slime-make-compilation-finished-continuation (current-buffer))))
+
+(defun slime-note-count-string (severity count &optional suppress-if-zero)
+  (cond ((and (zerop count) suppress-if-zero)
+         "")
+        (t (format "%2d %s%s " count severity (if (= count 1) "" "s")))))
+
+(defun slime-show-note-counts (notes &optional secs)
+  (let ((nerrors 0) (nwarnings 0) (nstyle-warnings 0) (nnotes 0))
+    (dolist (note notes)
+      (ecase (slime-note.severity note)
+	((:error :read-error) (incf nerrors))
+        (:warning             (incf nwarnings))
+        (:style-warning       (incf nstyle-warnings))
+        (:note                (incf nnotes))))
+    (message "Compilation finished:%s%s%s%s%s"
+             (slime-note-count-string "error" nerrors)
+             (slime-note-count-string "warning" nwarnings)
+             (slime-note-count-string "style-warning" nstyle-warnings t)
+             (slime-note-count-string "note" nnotes)
+             (if secs (format "[%s secs]" secs) ""))))
+
+(defun slime-xrefs-for-notes (notes)
+  (let ((xrefs))
+    (dolist (note notes)
+      (let* ((location (getf note :location))
+             (fn (cadr (assq :file (cdr location))))
+             (file (assoc fn xrefs))
+             (node
+              (cons (format "%s: %s" 
+                            (getf note :severity)
+                            (slime-one-line-ify (getf note :message)))
+                    location)))
+        (when fn
+          (if file
+              (push node (cdr file))
+              (setf xrefs (acons fn (list node) xrefs))))))
+    xrefs))
+
+(defun slime-one-line-ify (string)
+  "Return a single-line version of STRING.
+Each newlines and following indentation is replaced by a single space."
+  (with-temp-buffer
+    (insert string)
+    (goto-char (point-min))
+    (while (re-search-forward "\n[\n \t]*" nil t)
+      (replace-match " "))
+    (buffer-string)))
+
+(defun slime-compilation-finished (result buffer &optional emacs-snapshot)
+  (let ((notes (slime-compiler-notes)))
+    (with-current-buffer buffer
+      (setf slime-compilation-just-finished t)
+      (destructuring-bind (result secs) result
+        (slime-show-note-counts notes secs)
+        (when slime-highlight-compiler-notes
+          (slime-highlight-notes notes))))
+    (run-hook-with-args 'slime-compilation-finished-hook notes emacs-snapshot)))
+
+(defun slime-make-compilation-finished-continuation (current-buffer &optional emacs-snapshot)
+  (lexical-let ((buffer current-buffer) (snapshot emacs-snapshot))
+    (lambda (result)
+      (slime-compilation-finished result buffer snapshot))))
+
+(defun slime-highlight-notes (notes)
+  "Highlight compiler notes, warnings, and errors in the buffer."
+  (interactive (list (slime-compiler-notes)))
+  (with-temp-message "Highlighting notes..."
+    (save-excursion
+      (save-restriction
+        (widen)                  ; highlight notes on the whole buffer
+        (slime-remove-old-overlays)
+        (mapc #'slime-overlay-note (slime-merge-notes-for-display notes))))))
+
+(defun slime-compiler-notes ()
+  "Return all compiler notes, warnings, and errors."
+  (slime-eval `(swank:compiler-notes-for-emacs)))
+
+(defun slime-remove-old-overlays ()
+  "Delete the existing Slime overlays in the current buffer."
+  (dolist (buffer (slime-filter-buffers (lambda () slime-mode)))
+    (with-current-buffer buffer
+      (save-excursion
+        (save-restriction
+          (widen)                ; remove overlays within the whole buffer.
+          (goto-char (point-min))
+          (while (not (eobp))
+            (dolist (o (overlays-at (point)))
+              (when (overlay-get o 'slime)
+                (delete-overlay o)))
+            (goto-char (next-overlay-change (point)))))))))
+
+(defun slime-filter-buffers (predicate)
+  "Return a list of where PREDICATE returns true.
+PREDICATE is executed in the buffer to test."
+  (remove-if-not (lambda (%buffer)
+                   (with-current-buffer %buffer
+                     (funcall predicate)))
+                 (buffer-list)))
+
+
+;;;;; Merging together compiler notes in the same location.
+
+(defun slime-merge-notes-for-display (notes)
+  "Merge together notes that refer to the same location.
+This operation is \"lossy\" in the broad sense but not for display purposes."
+  (mapcar #'slime-merge-notes
+          (slime-group-similar 'slime-notes-in-same-location-p notes)))
+
+(defun slime-merge-notes (notes)
+  "Merge NOTES together. Keep the highest severity, concatenate the messages."
+  (let* ((new-severity (reduce #'slime-most-severe notes
+                               :key #'slime-note.severity))
+         (new-message (mapconcat #'slime-note.short-message notes "\n")))
+    (let ((new-note (copy-list (car notes))))
+      (setf (getf new-note :message) new-message)
+      (setf (getf new-note :severity) new-severity)
+      new-note)))
+
+;; XXX: unused function
+(defun slime-intersperse (element list)
+  "Intersperse ELEMENT between each element of LIST."
+  (if (null list) 
+      '()
+    (cons (car list)
+          (mapcan (lambda (x) (list element x)) (cdr list)))))
+
+(defun slime-notes-in-same-location-p (a b)
+  (equal (slime-note.location a) (slime-note.location b)))
+
+(defun slime-group-similar (similar-p list)
+  "Return the list of lists of 'similar' adjacent elements of LIST.
+The function SIMILAR-P is used to test for similarity.
+The order of the input list is preserved."
+  (if (null list)
+      nil
+    (let ((accumulator (list (list (car list)))))
+      (dolist (x (cdr list))
+        (if (funcall similar-p x (caar accumulator))
+            (push x (car accumulator))
+          (push (list x) accumulator)))
+      (reverse (mapcar #'reverse accumulator)))))
+
+
+;;;;; Compiler notes list
+
+(defun slime-maybe-show-xrefs-for-notes (&optional notes emacs-snapshot)
+  "Show the compiler notes NOTES if they come from more than one file."
+  (let* ((notes (or notes (slime-compiler-notes))) 
+         (xrefs (slime-xrefs-for-notes notes)))
+    (when (slime-length> xrefs 1)          ; >1 file
+      (slime-show-xrefs
+       xrefs 'definition "Compiler notes" (slime-current-package)
+       emacs-snapshot))))
+
+(defun slime-note-has-location-p (note)
+  (not (eq ':error (car (slime-note.location note)))))
+
+(defun slime-maybe-list-compiler-notes (notes &optional emacs-snapshot)
+  "Show the compiler notes if appropriate."
+  ;; don't pop up a buffer if all notes are already annotated in the
+  ;; buffer itself
+  (unless (every #'slime-note-has-location-p notes)
+    (slime-list-compiler-notes notes emacs-snapshot)))
+
+(defun slime-list-compiler-notes (notes &optional emacs-snapshot)
+  "Show the compiler notes NOTES in tree view."
+  (interactive (list (slime-compiler-notes)))
+  (with-temp-message "Preparing compiler note tree..."
+    (with-current-buffer
+        (slime-get-temp-buffer-create "*compiler notes*"
+                                      :mode 'slime-compiler-notes-mode
+                                      :emacs-snapshot emacs-snapshot)
+      (let ((inhibit-read-only t))
+        (erase-buffer)
+        (when (null notes)
+          (insert "[no notes]"))
+        (dolist (tree (slime-compiler-notes-to-tree notes))
+          (slime-tree-insert tree "")
+          (insert "\n")))
+      (setq buffer-read-only t)
+      (goto-char (point-min)))))
+
+(defun slime-alistify (list key test)
+  "Partition the elements of LIST into an alist.  
+KEY extracts the key from an element and TEST is used to compare keys."
+  (declare (type function key))
+  (let ((alist '()))
+    (dolist (e list)
+      (let* ((k (funcall key e))
+	     (probe (assoc* k alist :test test)))
+	(if probe
+	    (push e (cdr probe))
+            (push (cons k (list e)) alist))))
+    ;; Put them back in order.
+    (loop for (key . value) in alist
+          collect (cons key (reverse value)))))
+
+(defun slime-note.severity (note)
+  (plist-get note :severity))
+
+(defun slime-note.message (note)
+  (plist-get note :message))
+
+(defun slime-note.short-message (note)
+  (or (plist-get note :short-message)
+      (plist-get note :message)))
+
+(defun slime-note.location (note)
+  (plist-get note :location))
+
+(defun slime-severity-label (severity)
+  (ecase severity
+    (:note "Notes")
+    (:warning "Warnings")
+    (:error "Errors")
+    (:read-error "Read Errors")
+    (:style-warning "Style Warnings")))
+
+(defvar slime-tree-printer 'slime-tree-default-printer)
+
+(defun slime-tree-for-note (note)
+  (make-slime-tree :item (slime-note.message note)
+                   :plist (list 'note note)
+                   :print-fn slime-tree-printer))
+
+(defun slime-tree-for-severity (severity notes collapsed-p)
+  (make-slime-tree :item (format "%s (%d)" 
+                                 (slime-severity-label severity)
+                                 (length notes))
+                   :kids (mapcar #'slime-tree-for-note notes)
+                   :collapsed-p collapsed-p))
+
+(defun slime-compiler-notes-to-tree (notes)
+  (let* ((alist (slime-alistify notes #'slime-note.severity #'eq))
+         (collapsed-p (slime-length> alist 1)))
+    (loop for (severity . notes) in alist
+          collect (slime-tree-for-severity severity notes 
+                                           collapsed-p))))
+
+(defvar slime-compiler-notes-mode-map)
+
+(define-derived-mode slime-compiler-notes-mode fundamental-mode 
+  "Compiler Notes"
+  "\\<slime-compiler-notes-mode-map>\
+\\{slime-compiler-notes-mode-map}"
+  (slime-set-truncate-lines))
+
+(slime-define-keys slime-compiler-notes-mode-map
+  ((kbd "RET") 'slime-compiler-notes-default-action-or-show-details)
+  ([mouse-2] 'slime-compiler-notes-default-action-or-show-details/mouse)
+  ("q" 'slime-temp-buffer-quit))
+
+(defun slime-compiler-notes-default-action-or-show-details/mouse (event)
+  "Invoke the action pointed at by the mouse, or show details."
+  (interactive "e")
+  (destructuring-bind (mouse-2 (w pos &rest _) &rest __) event
+    (save-excursion
+      (goto-char pos)
+      (let ((fn (get-text-property (point) 
+                                   'slime-compiler-notes-default-action)))
+	(if fn (funcall fn) (slime-compiler-notes-show-details))))))
+
+(defun slime-compiler-notes-default-action-or-show-details ()
+  "Invoke the action at point, or show details."
+  (interactive)
+  (let ((fn (get-text-property (point) 'slime-compiler-notes-default-action)))
+    (if fn (funcall fn) (slime-compiler-notes-show-details))))
+
+(defun slime-compiler-notes-show-details ()
+  (interactive)
+  (let* ((tree (slime-tree-at-point))
+         (note (plist-get (slime-tree.plist tree) 'note))
+         (inhibit-read-only t))
+    (cond ((not (slime-tree-leaf-p tree))
+           (slime-tree-toggle tree))
+          (t
+           (slime-show-source-location (slime-note.location note) t)))))
+
+
+;;;;;; Tree Widget
+
+(defstruct (slime-tree (:conc-name slime-tree.))
+  item
+  (print-fn #'slime-tree-default-printer :type function)
+  (kids '() :type list)
+  (collapsed-p t :type boolean)
+  (prefix "" :type string)
+  (start-mark nil)
+  (end-mark nil)
+  (plist '() :type list))
+
+(defun slime-tree-leaf-p (tree)
+  (not (slime-tree.kids tree)))
+
+(defun slime-tree-default-printer (tree)
+  (princ (slime-tree.item tree) (current-buffer)))
+
+(defun slime-tree-decoration (tree)
+  (cond ((slime-tree-leaf-p tree) "-- ")
+	((slime-tree.collapsed-p tree) "[+] ")
+	(t "-+  ")))
+
+(defun slime-tree-insert-list (list prefix)
+  "Insert a list of trees."
+  (loop for (elt . rest) on list 
+	do (cond (rest
+		  (insert prefix " |")
+		  (slime-tree-insert elt (concat prefix " |"))
+                  (insert "\n"))
+		 (t
+		  (insert prefix " `")
+		  (slime-tree-insert elt (concat prefix "  "))))))
+
+(defun slime-tree-insert-decoration (tree)
+  (insert (slime-tree-decoration tree)))
+
+(defun slime-tree-indent-item (start end prefix)
+  "Insert PREFIX at the beginning of each but the first line.
+This is used for labels spanning multiple lines."
+  (save-excursion
+    (goto-char end)
+    (beginning-of-line)
+    (while (< start (point))
+      (insert-before-markers prefix)
+      (forward-line -1))))
+
+(defun slime-tree-insert (tree prefix)
+  "Insert TREE prefixed with PREFIX at point."
+  (with-struct (slime-tree. print-fn kids collapsed-p start-mark end-mark) tree
+    (let ((line-start (line-beginning-position)))
+      (setf start-mark (point-marker))
+      (slime-tree-insert-decoration tree)
+      (funcall print-fn tree)
+      (slime-tree-indent-item start-mark (point) (concat prefix "   "))
+      (add-text-properties line-start (point) (list 'slime-tree tree))
+      (set-marker-insertion-type start-mark t)
+      (when (and kids (not collapsed-p))
+        (terpri (current-buffer))
+        (slime-tree-insert-list kids prefix))
+      (setf (slime-tree.prefix tree) prefix)
+      (setf end-mark (point-marker)))))
+
+(defun slime-tree-at-point ()
+  (cond ((get-text-property (point) 'slime-tree))
+        (t (error "No tree at point"))))
+
+(defun slime-tree-delete (tree)
+  "Delete the region for TREE."
+  (delete-region (slime-tree.start-mark tree)
+                 (slime-tree.end-mark tree)))
+
+(defun slime-tree-toggle (tree)
+  "Toggle the visibility of TREE's children."
+  (with-struct (slime-tree. collapsed-p start-mark end-mark prefix) tree
+    (setf collapsed-p (not collapsed-p))
+    (slime-tree-delete tree)
+    (insert-before-markers " ") ; move parent's end-mark
+    (backward-char 1)
+    (slime-tree-insert tree prefix)
+    (delete-char 1)
+    (goto-char start-mark)))
+
+
+;;;;; Adding a single compiler note
+
+(defun slime-overlay-note (note)
+  "Add a compiler note to the buffer as an overlay.
+If an appropriate overlay for a compiler note in the same location
+already exists then the new information is merged into it. Otherwise a
+new overlay is created."
+  (multiple-value-bind (start end) (slime-choose-overlay-region note)
+    (when start
+      (goto-char start)
+      (let ((severity (plist-get note :severity))
+            (message (plist-get note :message))
+            (overlay (slime-note-at-point)))
+        (if overlay
+            (slime-merge-note-into-overlay overlay severity message)
+            (slime-create-note-overlay note start end severity message))))))
+
+(defun slime-create-note-overlay (note start end severity message)
+  "Create an overlay representing a compiler note.
+The overlay has several properties:
+  FACE       - to underline the relevant text.
+  SEVERITY   - for future reference, :NOTE, :STYLE-WARNING, :WARNING, or :ERROR.
+  MOUSE-FACE - highlight the note when the mouse passes over.
+  HELP-ECHO  - a string describing the note, both for future reference
+               and for display as a tooltip (due to the special
+               property name)."
+  (let ((overlay (make-overlay start end)))
+    (flet ((putp (name value) (overlay-put overlay name value)))
+      (putp 'slime note)
+      (putp 'face (slime-severity-face severity))
+      (putp 'severity severity)
+      (unless (slime-emacs-20-p)
+	(putp 'mouse-face 'highlight))
+      (putp 'help-echo message)
+      overlay)))
+
+;; XXX Obsolete due to `slime-merge-notes-for-display' doing the
+;; work already -- unless we decide to put several sets of notes on a
+;; buffer without clearing in between, which only this handles.
+(defun slime-merge-note-into-overlay (overlay severity message)
+  "Merge another compiler note into an existing overlay.
+The help text describes both notes, and the highest of the severities
+is kept."
+  (flet ((putp (name value) (overlay-put overlay name value))
+	 (getp (name)       (overlay-get overlay name)))
+    (putp 'severity (slime-most-severe severity (getp 'severity)))
+    (putp 'face (slime-severity-face (getp 'severity)))
+    (putp 'help-echo (concat (getp 'help-echo) "\n" message))))
+
+(defun slime-choose-overlay-region (note)
+  "Choose the start and end points for an overlay over NOTE.
+If the location's sexp is a list spanning multiple lines, then the
+region around the first element is used.
+Return nil if there's no useful source location."
+  (let ((location (slime-note.location note)))
+    (when location 
+      (destructure-case location
+        ((:error _) _ nil)                 ; do nothing
+        ((:location file pos _hints)
+         (cond ((eq (car file) ':source-form) nil)
+               (t
+                (destructure-case pos
+                  ((:position pos &optional alignp)
+                   (if (eq (slime-note.severity note) :read-error)
+                       (values pos (1+ pos))
+                     (slime-choose-overlay-for-sexp location)))
+                  (t 
+                   (slime-choose-overlay-for-sexp location))))))))))
+          
+(defun slime-choose-overlay-for-sexp (location)
+  (slime-goto-source-location location)
+  (skip-chars-forward "'#`")
+  (let ((start (point)))
+    (ignore-errors (slime-forward-sexp))
+    (if (slime-same-line-p start (point))
+        (values start (point))
+      (values (1+ start)
+              (progn (goto-char (1+ start))
+                     (ignore-errors (forward-sexp 1))
+                     (point))))))
+
+(defun slime-same-line-p (pos1 pos2)
+  "Return t if buffer positions POS1 and POS2 are on the same line."
+  (save-excursion (goto-char (min pos1 pos2))
+                  (<= (max pos1 pos2) (line-end-position))))
+
+(defun slime-severity-face (severity)
+  "Return the name of the font-lock face representing SEVERITY."
+  (ecase severity
+    (:error         'slime-error-face)
+    (:read-error    'slime-error-face)
+    (:warning       'slime-warning-face)
+    (:style-warning 'slime-style-warning-face)
+    (:note          'slime-note-face)))
+
+(defun slime-most-severe (sev1 sev2)
+  "Return the most servere of two conditions.
+Severity is ordered as :NOTE < :STYLE-WARNING < :WARNING < :ERROR."
+                                        ; Well, not exactly Smullyan..
+  (let ((order '(:note :style-warning :warning :error :read-error)))
+    (if (>= (position sev1 order) 
+            (position sev2 order))
+        sev1
+      sev2)))
+
+;; XXX: unused function
+(defun slime-visit-source-path (source-path)
+  "Visit a full source path including the top-level form."
+  (goto-char (point-min))
+  (slime-forward-source-path source-path))
+
+(defun slime-forward-positioned-source-path (source-path)
+  "Move forward through a sourcepath from a fixed position.
+The point is assumed to already be at the outermost sexp, making the
+first element of the source-path redundant."
+  (ignore-errors 
+    (slime-forward-sexp)
+    (beginning-of-defun))
+  (when-let (source-path (cdr source-path))
+    (down-list 1)
+    (slime-forward-source-path source-path)))
+
+(defun slime-forward-source-path (source-path)
+  (let ((origin (point)))
+    (condition-case nil
+        (progn
+          (loop for (count . more) on source-path
+                do (progn
+                     (slime-forward-sexp count)
+                     (when more (down-list 1))))
+          ;; Align at beginning
+          (slime-forward-sexp)
+          (beginning-of-sexp))
+      (error (goto-char origin)))))
+
+(defun slime-filesystem-toplevel-directory ()
+  ;; Windows doesn't have a true toplevel root directory, and all
+  ;; filenames look like "c:/foo/bar/quux.baz" from an Emacs
+  ;; perspective anyway.
+  (if (memq system-type '(ms-dos windows-nt))
+      ""
+      (file-name-as-directory "/")))
+
+(defun slime-file-name-merge-source-root (target-filename buffer-filename)
+  "Returns a filename where the source root directory of TARGET-FILENAME
+is replaced with the source root directory of BUFFER-FILENAME.
+
+If no common source root could be determined, return NIL.
+
+E.g. (slime-file-name-merge-source-root
+       \"/usr/local/src/joe/upstream/sbcl/code/late-extensions.lisp\"
+       \"/usr/local/src/joe/hacked/sbcl/compiler/deftype.lisp\")
+ 
+        ==> \"/usr/local/src/joe/hacked/sbcl/code/late-extensions.lisp\"
+"
+  (let ((target-dirs (slime-split-string (file-name-directory target-filename) "/" t))
+        (buffer-dirs (slime-split-string (file-name-directory buffer-filename) "/" t)))
+    ;; Starting from the end, we look if one of the TARGET-DIRS exists
+    ;; in BUFFER-FILENAME---if so, it and everything left from that dirname
+    ;; is considered to be the source root directory of BUFFER-FILENAME.
+    (loop with target-suffix-dirs = nil
+          with buffer-dirs* = (reverse buffer-dirs)
+          with target-dirs* = (reverse target-dirs)
+          for target-dir in target-dirs*
+          do (flet ((concat-dirs (dirs)
+                      (apply #'concat (mapcar #'file-name-as-directory dirs))))
+               (let ((pos (position target-dir buffer-dirs* :test #'equal)))
+                 (if (not pos)    ; TARGET-DIR not in BUFFER-FILENAME?
+                     (push target-dir target-suffix-dirs)
+                     (let* ((target-suffix (concat-dirs target-suffix-dirs)) ; PUSH reversed for us!
+                            (buffer-root   (concat-dirs (reverse (nthcdr pos buffer-dirs*)))))
+                       (return (concat (slime-filesystem-toplevel-directory)
+                                       buffer-root
+                                       target-suffix
+                                       (file-name-nondirectory target-filename))))))))))
+
+(defun slime-highlight-differences-in-dirname (base-dirname contrast-dirname)
+  "Returns a copy of BASE-DIRNAME where all differences between
+BASE-DIRNAME and CONTRAST-DIRNAME are propertized with a
+highlighting face."
+  (setq base-dirname (file-name-as-directory base-dirname))
+  (setq contrast-dirname (file-name-as-directory contrast-dirname))
+  (flet ((insert-dir (dirname)
+           (insert (file-name-as-directory dirname)))
+         (insert-dir/propzd (dirname)
+           (slime-insert-propertized '(face highlight) dirname)
+           (insert "/")))  ; Not exactly portable (to VMS...)
+    (let ((base-dirs (slime-split-string base-dirname "/" t))
+          (contrast-dirs (slime-split-string contrast-dirname "/" t)))
+      (with-temp-buffer
+        (loop initially (insert (slime-filesystem-toplevel-directory))
+              for base-dir in base-dirs do
+              (let ((pos (position base-dir contrast-dirs :test #'equal)))
+                (if (not pos)
+                    (insert-dir/propzd base-dir)
+                    (progn (insert-dir base-dir)
+                           (setq contrast-dirs (nthcdr (1+ pos) contrast-dirs))))))
+        (buffer-substring (point-min) (point-max))))))
+
+(defvar slime-warn-when-possibly-tricked-by-M-. t
+  "When working on multiple source trees simultaneously, the way
+`slime-edit-definition' (M-.) works can sometimes be confusing:
+
+`M-.' visits locations that are present in the current Lisp image,
+which works perfectly well as long as the image reflects the source
+tree that one is currently looking at.
+
+In the other case, however, one can easily end up visiting a file
+in a different source root directory (the one corresponding to
+the Lisp image), and is thus easily tricked to modify the wrong
+source files---which can lead to quite some stressfull cursing.
+
+If this variable is T, a warning message is issued to raise the
+user's attention whenever `M-.' is about opening a file in a
+different source root that also exists in the source root
+directory of the user's current buffer.
+
+There's no guarantee that all possible cases are covered, but
+if you encounter such a warning, it's a strong indication that
+you should check twice before modifying.")
+
+(defun slime-maybe-warn-for-different-source-root (target-filename buffer-filename)
+  (when slime-warn-when-possibly-tricked-by-M-.
+    (let ((guessed-target (slime-file-name-merge-source-root target-filename
+                                                             buffer-filename)))
+      (when (and guessed-target
+                 (not (equal guessed-target target-filename))
+                 (file-exists-p guessed-target))
+        (slime-message "Attention: This is `%s'."
+                       (concat (slime-highlight-differences-in-dirname
+                                 (file-name-directory target-filename)
+                                 (file-name-directory guessed-target))
+                               (file-name-nondirectory target-filename)))))))
+
+
+(defun slime-goto-location-buffer (buffer)
+  (flet ((file-truename-safe (filename) (and filename (file-truename filename))))
+    (destructure-case buffer
+      ((:file filename)
+       (let ((target-filename (file-truename-safe (slime-from-lisp-filename filename)))
+             (buffer-filename (file-truename-safe (buffer-file-name))))
+         (when buffer-filename
+           (slime-maybe-warn-for-different-source-root target-filename buffer-filename))
+         (unless (and buffer-filename (string= buffer-filename target-filename))
+           (set-buffer (find-file-noselect target-filename t))))
+       (goto-char (point-min)))
+      ((:buffer buffer-name)
+       (let ((old-buffer-filename (file-truename-safe (buffer-file-name)))
+             (target-buffer-filename (file-truename-safe
+                                      (buffer-file-name (get-buffer buffer-name)))))
+         (when (and target-buffer-filename old-buffer-filename)
+           (slime-maybe-warn-for-different-source-root target-buffer-filename
+                                                       old-buffer-filename)))
+       (set-buffer buffer-name)
+       (goto-char (point-min)))
+      ((:source-form string)
+       (set-buffer (get-buffer-create "*SLIME Source Form*"))
+       (erase-buffer)
+       (lisp-mode)
+       (insert string)
+       (goto-char (point-min)))
+      ((:zip file entry)
+       (require 'arc-mode)
+       (set-buffer (find-file-noselect file t))
+       (goto-char (point-min))
+       (re-search-forward (concat "  " entry "$"))
+       (let ((buffer (save-window-excursion
+                       (archive-extract)
+                       (current-buffer))))
+         (set-buffer buffer)
+         (goto-char (point-min)))))))
+
+(defun slime-goto-location-position (position)
+  (save-restriction-if-possible         ; try to keep restriction if possible.
+    (widen)
+    (destructure-case position
+      ((:position pos &optional align-p)
+       (goto-char pos)
+       (when align-p
+         (slime-forward-sexp)
+         (beginning-of-sexp)))
+      ((:line start &optional column)
+       (goto-line start)
+       (cond (column (move-to-column column))
+             (t (skip-chars-forward " \t"))))
+      ((:function-name name)
+       (let ((case-fold-search t)
+             (name (regexp-quote name)))
+         (or 
+          (re-search-forward 
+           (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\S_" name) nil t)
+          (re-search-forward 
+           (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +(*%s\\S_" name) nil t)
+          (re-search-forward 
+           (format "[( \t]%s\\>\\(\\s \\|$\\)" name) nil t)))
+       (goto-char (match-beginning 0)))
+      ((:method name specializers &rest qualifiers)
+       (slime-search-method-location name specializers qualifiers))
+      ((:source-path source-path start-position)
+       (cond (start-position
+              (goto-char start-position)
+              (slime-forward-positioned-source-path source-path))
+             (t
+              (slime-forward-source-path source-path))))
+      ;; Goes to "start" then looks for the anchor text, then moves
+      ;; delta from that position.
+      ((:text-anchored start text delta)
+       (goto-char start)
+       (slime-isearch text)
+       (forward-char delta)))))
+
+(defun slime-search-method-location (name specializers qualifiers)
+  ;; Look for a sequence of words (def<something> method name
+  ;; qualifers specializers don't look for "T" since it isn't requires
+  ;; (arg without t) as class is taken as such.
+  (let* ((case-fold-search t)
+         (name (regexp-quote name))
+         (qualifiers (mapconcat (lambda (el) (concat ".+?\\<" el "\\>"))
+                                qualifiers ""))
+         (specializers (mapconcat (lambda (el) 
+                                    (if (eql (aref el 0) ?\()
+                                        (let ((spec (read el)))
+                                          (if (eq (car spec) 'EQL)
+                                              (concat ".*?\\n\\{0,1\\}.*?(EQL.*?'\\{0,1\\}" (format "%s" (second spec)) ")")
+                                            (error "don't understand specializer: %s,%s" el (car spec))))
+                                      (concat ".+?\n\\{0,1\\}.+?\\<" el "\\>")))
+                                  (remove "T" specializers) ""))
+         (regexp (format "\\s *(def\\(\\s_\\|\\sw\\)*\\s +%s\\s +%s%s" name
+                         qualifiers specializers)))
+    (or (and (re-search-forward regexp  nil t)
+             (goto-char (match-beginning 0)))
+        ;;	(slime-goto-location-position `(:function-name ,name))
+        )))
+
+(defun slime-search-call-site (fname)
+  "Move to the place where FNAME called.
+Don't move if there are multiple or no calls in the current defun."
+  (save-restriction 
+    (narrow-to-defun)
+    (let ((start (point))
+          (regexp (concat "(" fname "[\n \t]")))
+      (cond ((and (re-search-forward regexp nil t)
+                  (not (re-search-forward regexp nil t)))
+             (goto-char (match-beginning 0)))
+            (t (goto-char start))))))
+
+(defun slime-goto-source-location (location &optional noerror)
+  "Move to the source location LOCATION.  Several kinds of locations
+are supported:
+
+<location> ::= (:location <buffer> <position> <hints>)
+             | (:error <message>) 
+
+<buffer>   ::= (:file <filename>)
+             | (:buffer <buffername>)
+             | (:source-form <string>)
+             | (:zip <file> <entry>)
+
+<position> ::= (:position <fixnum> [<align>]) ; 1 based
+             | (:line <line> [<column>])
+             | (:function-name <string>)
+             | (:source-path <list> <start-position>) 
+             | (:text-anchored <fixnum> <string> <fixnum>) 
+             | (:method <name string> <specializer strings> . <qualifiers strings>)"
+  (destructure-case location
+    ((:location buffer position hints)
+     (slime-goto-location-buffer buffer)
+     (slime-goto-location-position position)
+     (when-let (snippet (getf hints :snippet))
+       (slime-isearch snippet))
+     (when-let (fname (getf hints :call-site))
+       (slime-search-call-site fname)))
+    ((:error message)
+     (if noerror
+         (slime-message "%s" message)
+       (error "%s" message)))))
+
+(defmacro slime-point-moves-p (&rest body)
+  "Execute BODY and return true if the current buffer's point moved."
+  (let ((pointvar (gensym "point-")))
+    `(let ((,pointvar (point)))
+       (save-current-buffer , at body)
+       (/= ,pointvar (point)))))
+
+(put 'slime-point-moves-p 'lisp-indent-function 0)
+
+(defun slime-forward-sexp (&optional count)
+  "Like `forward-sexp', but understands reader-conditionals (#- and #+)."
+  (dotimes (i (or count 1))
+    (while (slime-point-moves-p (slime-forward-blanks)
+                                (slime-forward-reader-comment)
+                                (slime-forward-reader-conditional)))
+    (forward-sexp)))
+
+(defun slime-forward-blanks ()
+  "Move forward over all whitespace and newlines at point."
+  (ignore-errors
+    (while (slime-point-moves-p
+             (skip-syntax-forward " ")
+             ;; newlines aren't in lisp-mode's whitespace syntax class
+             (when (eolp) (forward-char))))))
+
+;; Emacs 21's forward-sexp understands #| |# comments in lisp-mode
+;; buffers, but (at least) Emacs 20's doesn't, so here it is.
+(defun slime-forward-reader-comment ()
+  "Move forward over #|...|# reader comments. The comments may be nested."
+  (when (looking-at "#|")
+    (goto-char (match-end 0))
+    (while (not (looking-at "|#"))
+      (re-search-forward (regexp-opt '("|#" "#|")))
+      (goto-char (match-beginning 0))
+      (when (looking-at "#|")           ; nested comment
+        (slime-forward-reader-comment)))
+    (goto-char (match-end 0))))
+
+(defun slime-forward-reader-conditional ()
+  "Move past any reader conditional (#+ or #-) at point."
+  (when (or (looking-at "#\\+")
+            (looking-at "#-"))
+    (goto-char (match-end 0))
+    (let* ((plus-conditional-p (eq (char-before) ?+))
+           (result (slime-eval-feature-conditional (read (current-buffer)))))
+      (unless (if plus-conditional-p result (not result))
+        ;; skip this sexp
+        (slime-forward-sexp)))))
+
+(defun slime-keywordify (symbol)
+  "Make a keyword out of the symbol SYMBOL."
+  (let ((name (downcase (symbol-name symbol))))
+    (intern (if (eq ?: (aref name 0)) 
+                name 
+              (concat ":" name)))))
+
+(defun slime-eval-feature-conditional (e)
+  "Interpret a reader conditional expression."
+  (if (symbolp e)
+      (memq (slime-keywordify e) (slime-lisp-features))
+    (funcall (ecase (slime-keywordify (car e))
+               (:and #'every)
+               (:or #'some)
+               (:not (lambda (f l) (not (apply f l)))))
+             #'slime-eval-feature-conditional
+             (cdr e))))
+
+
+;;;;; Incremental search
+;;
+;; Search for the longest match of a string in either direction.
+;;
+;; This is for locating text that is expected to be near the point and
+;; may have been modified (but hopefully not near the beginning!)
+
+(defun slime-isearch (string)
+  "Find the longest occurence of STRING either backwards of forwards.
+If multiple matches exist the choose the one nearest to point."
+  (goto-char
+   (let* ((start (point))
+          (len1 (slime-isearch-with-function 'search-forward string))
+          (pos1 (point)))
+     (goto-char start)
+     (let* ((len2 (slime-isearch-with-function 'search-backward string))
+            (pos2 (point)))
+       (cond ((and len1 len2)
+              ;; Have a match in both directions
+              (cond ((= len1 len2)
+                     ;; Both are full matches -- choose the nearest.
+                     (if (< (abs (- start pos1))
+                            (abs (- start pos2)))
+                         pos1 pos2))
+                    ((> len1 len2) pos1)
+                    ((> len2 len1) pos2)))
+             (len1 pos1)
+             (len2 pos2)
+             (t start))))))
+
+(defun slime-isearch-with-function (search-fn string)
+  "Search for the longest substring of STRING using SEARCH-FN.
+SEARCH-FN is either the symbol `search-forward' or `search-backward'."
+  (unless (string= string "")
+    (loop for i from 1 to (length string)
+          while (funcall search-fn (substring string 0 i) nil t)
+          for match-data = (match-data)
+          do (case search-fn
+               (search-forward  (goto-char (match-beginning 0)))
+               (search-backward (goto-char (1+ (match-end 0)))))
+          finally (return (if (null match-data)
+                              nil
+                            ;; Finish based on the last successful match
+                            (store-match-data match-data)
+                            (goto-char (match-beginning 0))
+                            (- (match-end 0) (match-beginning 0)))))))
+
+
+;;;;; Visiting and navigating the overlays of compiler notes
+
+(defvar slime-compilation-just-finished nil
+  "A buffer local variable which is T when we've just compiled a
+buffer and haven't yet started navigating its notes.")
+(make-variable-buffer-local 'slime-compilation-just-finished)
+
+(defun slime-next-note ()
+  "Go to and describe the next compiler note in the buffer."
+  (interactive)
+  (let ((here (point)))
+    (when (and slime-goto-first-note-after-compilation
+               slime-compilation-just-finished)
+      (goto-char (point-min))
+      (setf slime-compilation-just-finished nil))
+    (slime-find-next-note)
+    (if (slime-note-at-point)
+        (slime-show-note (slime-note-at-point))
+        (progn
+          (goto-char here)
+          (message "No next note.")))))
+
+(defun slime-previous-note ()
+  "Go to and describe the previous compiler note in the buffer."
+  (interactive)
+  (let ((here (point)))
+    (when (and slime-goto-first-note-after-compilation
+               slime-compilation-just-finished)
+      (goto-char (point-max))
+      (setf slime-compilation-just-finished nil))
+    (slime-find-previous-note)
+    (if (slime-note-at-point)
+        (slime-show-note (slime-note-at-point))
+        (progn
+          (goto-char here)
+          (message "No previous note.")))))
+
+(defun slime-remove-notes ()
+  "Remove compiler-note annotations from the current buffer."
+  (interactive)
+  (slime-remove-old-overlays))
+
+(defun slime-show-note (overlay)
+  "Present the details of a compiler note to the user."
+  (slime-temporarily-highlight-note overlay)
+  (let ((message (get-char-property (point) 'help-echo)))
+    (slime-message "%s" (if (zerop (length message)) "\"\"" message))))
+
+(defun slime-temporarily-highlight-note (overlay)
+  "Temporarily highlight a compiler note's overlay.
+The highlighting is designed to both make the relevant source more
+visible, and to highlight any further notes that are nested inside the
+current one.
+
+The highlighting is automatically undone before the next Emacs command."
+  (lexical-let ((old-face (overlay-get overlay 'face))
+                (overlay overlay))
+    (push (lambda () (overlay-put overlay 'face old-face))
+	  slime-pre-command-actions)
+    (overlay-put overlay 'face 'slime-highlight-face)))
+
+
+;;;;; Overlay lookup operations
+
+(defun slime-note-at-point ()
+  "Return the overlay for a note starting at point, otherwise NIL."
+  (find (point) (slime-note-overlays-at-point)
+	:key 'overlay-start))
+
+(defun slime-note-overlay-p (overlay)
+  "Return true if OVERLAY represents a compiler note."
+  (overlay-get overlay 'slime))
+
+(defun slime-note-overlays-at-point ()
+  "Return a list of all note overlays that are under the point."
+  (remove-if-not 'slime-note-overlay-p (overlays-at (point))))
+
+(defun slime-find-next-note ()
+  "Go to the next position with the `slime-note' text property.
+Retuns true if such a position is found."
+  (slime-find-note 'next-single-char-property-change))
+
+(defun slime-find-previous-note ()
+  "Go to the next position with the `slime' text property.
+Returns true if such a position is found."
+  (slime-find-note 'previous-single-char-property-change))
+
+(defun slime-find-note (next-candidate-fn)
+  "Seek out the beginning of a note.
+NEXT-CANDIDATE-FN is called to find each new position for consideration."
+  (let ((origin (point)))
+    (loop do (goto-char (funcall next-candidate-fn (point) 'slime))
+	  until (or (slime-note-at-point)
+		    (eobp)
+		    (bobp)))
+    (unless (slime-note-at-point)
+      (goto-char origin))))
+
+
+;;;; Arglist Display
+
+(defun slime-space (n)
+  "Insert a space and print some relevant information (function arglist).
+Designed to be bound to the SPC key.  Prefix argument can be used to insert
+more than one space."
+  (interactive "p")
+  (self-insert-command n)
+  (when (and slime-space-information-p
+             (slime-background-activities-enabled-p))
+    (slime-echo-arglist)))
+
+(defvar slime-echo-arglist-function 'slime-show-arglist)
+
+(defun slime-echo-arglist ()
+  "Display the arglist of the current form in the echo area."
+  (funcall slime-echo-arglist-function))
+
+(defun slime-show-arglist ()
+  (let ((op (slime-operator-before-point)))
+    (when op 
+      (slime-eval-async `(swank:operator-arglist ,op ,(slime-current-package))
+			(lambda (arglist)
+			  (when arglist
+			    (slime-message "%s" arglist)))))))
+
+(defun slime-operator-before-point ()
+  (ignore-errors 
+    (save-excursion
+      (backward-up-list 1)
+      (down-list 1)
+      (slime-symbol-name-at-point))))
+
+
+;;;; Completion
+
+;; XXX those long names are ugly to read; long names an indicator for
+;; bad factoring?
+
+(defvar slime-completions-buffer-name "*Completions*")
+
+(make-variable-buffer-local
+ (defvar slime-complete-saved-window-configuration nil
+   "Window configuration before we show the *Completions* buffer.
+This is buffer local in the buffer where the completion is
+performed."))
+
+(make-variable-buffer-local
+ (defvar slime-completions-window nil
+   "The window displaying *Completions* after saving window configuration.
+If this window is no longer active or displaying the completions
+buffer then we can ignore `slime-complete-saved-window-configuration'."))
+
+(defun slime-complete-maybe-save-window-configuration ()
+  "Maybe save the current window configuration.
+Return true if the configuration was saved."
+  (unless (or slime-complete-saved-window-configuration
+              (get-buffer-window slime-completions-buffer-name))
+    (setq slime-complete-saved-window-configuration
+          (current-window-configuration))
+    t))
+
+(defun slime-complete-delay-restoration ()
+  (make-local-hook 'pre-command-hook)
+  (add-hook 'pre-command-hook
+            'slime-complete-maybe-restore-window-configuration))
+
+(defun slime-complete-forget-window-configuration ()
+  (setq slime-complete-saved-window-configuration nil)
+  (setq slime-completions-window nil))
+
+(defun slime-complete-restore-window-configuration ()
+  "Restore the window config if available."
+  (remove-hook 'pre-command-hook
+               'slime-complete-maybe-restore-window-configuration)
+  (when (and slime-complete-saved-window-configuration
+             (slime-completion-window-active-p))
+    ;; XEmacs does not allow us to restore a window configuration from
+    ;; pre-command-hook, so we do it asynchronously.
+    (slime-run-when-idle
+     (lambda ()
+       (save-excursion
+         (set-window-configuration
+          slime-complete-saved-window-configuration))
+       (setq slime-complete-saved-window-configuration nil)
+       (when (buffer-live-p slime-completions-buffer-name)
+         (kill-buffer slime-completions-buffer-name))))))
+
+(defun slime-complete-maybe-restore-window-configuration ()
+  "Restore the window configuration, if the following command
+terminates a current completion."
+  (remove-hook 'pre-command-hook
+               'slime-complete-maybe-restore-window-configuration)
+  (condition-case err
+      (cond ((find last-command-char "()\"'`,# \r\n:")
+             (slime-complete-restore-window-configuration))
+            ((not (slime-completion-window-active-p))
+             (slime-complete-forget-window-configuration))
+            (t
+             (slime-complete-delay-restoration)))
+    (error
+     ;; Because this is called on the pre-command-hook, we mustn't let
+     ;; errors propagate.
+     (message "Error in slime-complete-restore-window-configuration: %S" err))))
+
+(defun slime-completion-window-active-p ()
+  "Is the completion window currently active?"
+  (and (window-live-p slime-completions-window)
+       (equal (buffer-name (window-buffer slime-completions-window))
+              slime-completions-buffer-name)))
+
+(defun slime-display-completion-list (completions base)
+  (let ((savedp (slime-complete-maybe-save-window-configuration)))
+    (with-output-to-temp-buffer slime-completions-buffer-name
+      (display-completion-list completions)
+      (let ((offset (- (point) 1 (length base))))
+        (with-current-buffer standard-output
+          (setq completion-base-size offset)
+          (set-syntax-table lisp-mode-syntax-table))))
+    (when savedp
+      (setq slime-completions-window
+            (get-buffer-window slime-completions-buffer-name)))))
+  
+(defun slime-display-or-scroll-completions (completions base)
+  (cond ((and (eq last-command this-command)
+              (slime-completion-window-active-p))
+         (slime-scroll-completions))
+        (t
+         (slime-display-completion-list completions base)))
+  (slime-complete-delay-restoration))
+
+(defun slime-scroll-completions ()
+  (let ((window slime-completions-window))
+    (with-current-buffer (window-buffer window)
+      (if (pos-visible-in-window-p (point-max) window)
+          (set-window-start window (point-min))
+        (save-selected-window
+          (select-window window)
+          (scroll-up))))))
+
+(defun slime-complete-symbol ()
+  "Complete the symbol at point.
+
+Completion is performed by `slime-complete-symbol-function'."
+  (interactive)
+  (funcall slime-complete-symbol-function))
+
+(defun slime-simple-complete-symbol ()
+  "Complete the symbol at point.  
+Perform completion more similar to Emacs' complete-symbol."
+  (or (slime-maybe-complete-as-filename)
+      (let* ((end (point))
+             (beg (slime-symbol-start-pos))
+             (prefix (buffer-substring-no-properties beg end))
+             (result (slime-simple-completions prefix)))
+        (destructuring-bind (completions partial) result
+          (if (null completions)
+              (progn (slime-minibuffer-respecting-message
+                      "Can't find completion for \"%s\"" prefix)
+                     (ding)
+                     (slime-complete-restore-window-configuration))
+            (insert-and-inherit (substring partial (length prefix)))
+            (cond ((slime-length= completions 1)
+                   (slime-minibuffer-respecting-message "Sole completion")
+                   (slime-complete-restore-window-configuration))
+                  ;; Incomplete
+                  (t
+                   (slime-minibuffer-respecting-message
+                    "Complete but not unique")
+                   (slime-display-or-scroll-completions completions
+                                                        partial))))))))
+
+(defun slime-maybe-complete-as-filename ()
+  "If point is at a string starting with \", complete it as filename.
+Return nil iff if point is not at filename."
+  (if (save-excursion (re-search-backward "\"[^ \t\n]+\\=" nil t))
+      (let ((comint-completion-addsuffix '("/" . "\"")))
+        (if slime-when-complete-filename-expand
+            (comint-replace-by-expanded-filename)
+          (comint-dynamic-complete-as-filename))
+        t)
+    nil))
+
+(defun slime-minibuffer-respecting-message (format &rest format-args)
+  "Display TEXT as a message, without hiding any minibuffer contents."
+  (let ((text (format " [%s]" (apply #'format format format-args))))
+    (if (minibuffer-window-active-p (minibuffer-window))
+        (if (fboundp 'temp-minibuffer-message) ;; XEmacs
+            (temp-minibuffer-message text)
+          (minibuffer-message text))
+      (message "%s" text))))
+
+(defvar slime-read-expression-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-map)
+    (define-key map "\t" 'slime-complete-symbol)
+    (define-key map "\M-\t" 'slime-complete-symbol)
+    map)
+  "Minibuffer keymap used for reading CL expressions.")
+
+(defvar slime-read-expression-history '()
+  "History list of expressions read from the minibuffer.")
+ 
+(defun slime-read-from-minibuffer (prompt &optional initial-value)
+  "Read a string from the minibuffer, prompting with PROMPT.  
+If INITIAL-VALUE is non-nil, it is inserted into the minibuffer before
+reading input.  The result is a string (\"\" if no input was given)."
+  (let ((minibuffer-setup-hook 
+         (cons (lexical-let ((package (slime-current-package))
+                             (connection (slime-connection)))
+                 (lambda ()
+                   (setq slime-buffer-package package)
+                   (setq slime-buffer-connection connection)
+                   (set-syntax-table lisp-mode-syntax-table)))
+	       minibuffer-setup-hook)))
+    (read-from-minibuffer prompt initial-value slime-read-expression-map
+			  nil 'slime-read-expression-history)))
+
+(defun slime-bogus-completion-alist (list)
+  "Make an alist out of list.
+The same elements go in the CAR, and nil in the CDR. To support the
+apparently very stupid `try-completions' interface, that wants an
+alist but ignores CDRs."
+  (mapcar (lambda (x) (cons x nil)) list))
+
+(defun slime-simple-completions (prefix)
+  (slime-eval `(swank:simple-completions ,prefix ',(slime-current-package))))
+
+
+;;;; Edit definition
+
+(defvar slime-find-definition-history-ring (make-ring 20)
+  "History ring recording the definition-finding \"stack\".")
+
+(defun slime-push-definition-stack (&optional marker narrowing-configuration)
+  "Add MARKER and NARROWING-CONFIGURATION to the edit-definition history stack.
+If MARKER is nil, use the current point. If NARROWING-CONFIGURATION is nil, 
+look if the current buffer is narrowed, and if so use the relevant values."
+  (ring-insert-at-beginning slime-find-definition-history-ring 
+    (list (or marker (point-marker))
+          (or narrowing-configuration
+              (slime-current-narrowing-configuration)))))
+
+(defun slime-pop-find-definition-stack ()
+  "Pop the edit-definition stack and goto the location."
+  (interactive)
+  (unless (ring-empty-p slime-find-definition-history-ring)
+    (destructuring-bind (marker narrowing-cfg)
+        (ring-remove slime-find-definition-history-ring)
+      (let ((buffer (marker-buffer marker))
+            (narrowedp  (slime-narrowing-configuration.narrowedp narrowing-cfg))
+            (narrow-beg (slime-narrowing-configuration.beg narrowing-cfg))
+            (narrow-end (slime-narrowing-configuration.end narrowing-cfg)))
+        (if (buffer-live-p buffer)
+            (progn (switch-to-buffer buffer)
+                   (goto-char (marker-position marker))
+                   (when narrowedp
+                     (narrow-to-region narrow-beg narrow-end)))
+            ;; If this buffer was deleted, recurse to try the next one
+            (slime-pop-find-definition-stack))))))
+
+(defstruct (slime-definition (:conc-name slime-definition.)
+                             (:type list))
+  dspec location)
+
+(defun slime-edit-definition (name &optional where)
+  "Lookup the definition of the name at point.  
+If there's no name at point, or a prefix argument is given, then the
+function name is prompted."
+  (interactive (list (slime-read-symbol-name "Name: ")))
+  (let ((definitions (slime-eval `(swank:find-definitions-for-emacs ,name))))
+    (cond
+     ((null definitions)
+      (if slime-edit-definition-fallback-function
+          (funcall slime-edit-definition-fallback-function name)
+        (error "No known definition for: %s" name)))
+     ((and (slime-length= definitions 1)
+           (eql (car (slime-definition.location (car definitions))) :error))
+      (if slime-edit-definition-fallback-function
+          (funcall slime-edit-definition-fallback-function name)
+        (error "%s" (cadr (slime-definition.location (car definitions))))))
+     (t 
+      (slime-goto-definition name definitions where)))))
+
+(defun slime-find-tag-if-tags-table-visited (name)
+  "Find tag (in current tags table) whose name contains NAME.
+If no tags table is visited, don't offer to visit one;
+just signal that no definition is known."
+  (if tags-table-list
+      (find-tag name)
+    (error "No known definition for: %s; use M-x visit-tags-table RET" name)))
+
+(defun slime-goto-definition (name definitions &optional where)
+  (slime-push-definition-stack)
+  (let ((all-locations-equal
+         (or (null definitions)
+             (let ((first-location (slime-definition.location (first definitions))))
+               (every (lambda (definition)
+                        (equal (slime-definition.location definition)
+                               first-location))
+                      (rest definitions))))))
+    (if (and (slime-length> definitions 1)
+             (not all-locations-equal))
+        (slime-show-definitions name definitions)
+      (let ((def (car definitions)))
+        (destructure-case (slime-definition.location def)
+          ;; Take care of errors before switching any windows/buffers.
+          ((:error message)
+           (error "%s" message))
+          (t
+           (cond ((equal where 'window)
+                  (slime-goto-definition-other-window (car definitions)))
+                 ((equal where 'frame)
+                  (let ((pop-up-frames t))
+                    (slime-goto-definition-other-window (car definitions))))
+                 (t
+                  (slime-goto-source-location (slime-definition.location
+                                               (car definitions)))
+                  (switch-to-buffer (current-buffer))))))))))
+
+(defun slime-goto-definition-other-window (definition)
+  (slime-pop-to-other-window)
+  (slime-goto-source-location (slime-definition.location definition))
+  (switch-to-buffer (current-buffer)))
+
+(defun slime-pop-to-other-window ()
+  "Pop to the other window, but not to any particular buffer."
+  (pop-to-buffer (current-buffer) t))
+
+(defun slime-edit-definition-other-window (name)
+  "Like `slime-edit-definition' but switch to the other window."
+  (interactive (list (slime-read-symbol-name "Symbol: ")))
+  (slime-edit-definition name 'window))
+
+(defun slime-edit-definition-other-frame (name)
+  "Like `slime-edit-definition' but switch to the other window."
+  (interactive (list (slime-read-symbol-name "Symbol: ")))
+  (slime-edit-definition name 'frame))
+
+(defun slime-edit-definition-with-etags (name)
+  (interactive (list (slime-read-symbol-name "Symbol: ")))
+  (let ((tagdefs (slime-etags-definitions name)))
+    (cond (tagdefs 
+           (message "Using tag file...")
+           (slime-goto-definition name tagdefs))
+          (t
+           (error "No known definition for: %s" name)))))
+
+(defun slime-etags-definitions (name)
+  "Search definitions matching NAME in the tags file.
+The result is a (possibly empty) list of definitions."
+  (require 'etags)
+  (let ((defs '()))
+    (save-excursion
+      (let ((first-time t))
+        (while (visit-tags-table-buffer (not first-time))
+          (setq first-time nil)
+          (goto-char (point-min))
+          (while (search-forward name nil t)
+            (beginning-of-line)
+            (destructuring-bind (hint line &rest pos) (etags-snarf-tag)
+              (unless (eq hint t)       ; hint==t if we are in a filename line
+                (let ((file (expand-file-name (file-of-tag))))
+                  (let ((loc `(:location (:file ,file)
+                                         (:line ,line)
+                                         (:snippet ,hint))))
+                    (push (list hint loc) defs))))))))
+      (reverse defs))))
+
+(defun slime-show-definitions (name definitions)
+  (slime-show-xrefs 
+   `((,name . ,(loop for (dspec location) in definitions
+                     collect (cons dspec location))))
+   'definition
+   name
+   (slime-current-package)))
+
+;;;;; first-change-hook
+
+(defun slime-first-change-hook ()
+  "Notify Lisp that a source file's buffer has been modified."
+  ;; Be careful not to disturb anything!
+  ;; In particular if we muck up the match-data then query-replace
+  ;; breaks. -luke (26/Jul/2004)
+  (save-excursion
+    (save-match-data
+      (when (and (buffer-file-name)
+                 (file-exists-p (buffer-file-name))
+                 (slime-background-activities-enabled-p))
+        (let ((filename (slime-to-lisp-filename (buffer-file-name))))          
+           (slime-eval-async `(swank:buffer-first-change ,filename)))))))
+
+(defun slime-setup-first-change-hook ()
+  (add-hook (make-local-variable 'first-change-hook)
+            'slime-first-change-hook))
+
+(add-hook 'slime-mode-hook 'slime-setup-first-change-hook)
+
+
+;;;; Eval for Lisp
+
+(defun slime-eval-for-lisp (thread tag form-string)
+  (let ((ok nil) 
+        (value nil)
+        (c (slime-connection)))
+    (unwind-protect (progn
+                      (slime-check-eval-in-emacs-enabled)
+                      (setq value (eval (read form-string)))
+                      (setq ok t))
+      (let ((result (if ok `(:ok ,value) `(:abort))))
+        (slime-dispatch-event `(:emacs-return ,thread ,tag ,result) c)))))
+
+(defun slime-check-eval-in-emacs-enabled ()
+  "Raise an error if `slime-enable-evaluate-in-emacs' isn't true."
+  (unless slime-enable-evaluate-in-emacs
+    (error "slime-eval-in-emacs disabled for security. Set slime-enable-evaluate-in-emacs true to enable it.")))
+
+
+;;;; `ED'
+
+(defvar slime-ed-frame nil
+  "The frame used by `slime-ed'.")
+
+(defcustom slime-ed-use-dedicated-frame t
+  "*When non-nil, `slime-ed' will create and reuse a dedicated frame."
+  :type 'boolean
+  :group 'slime-mode)
+
+(defun slime-ed (what)
+  "Edit WHAT.
+
+WHAT can be:
+  A filename (string),
+  A list (FILENAME LINE [COLUMN]),
+  A list (FILENAME :charpos CHARPOS),
+  A function name (symbol or cons),
+  nil.
+
+This is for use in the implementation of COMMON-LISP:ED."
+  ;; Without `save-excursion' very strange things happen if you call
+  ;; (swank:ed-in-emacs X) from the REPL. -luke (18/Jan/2004)
+  (save-excursion
+    (when slime-ed-use-dedicated-frame
+      (unless (and slime-ed-frame (frame-live-p slime-ed-frame))
+        (setq slime-ed-frame (make-frame)))
+      (select-frame slime-ed-frame))
+    (cond ((stringp what)
+           (find-file (slime-from-lisp-filename what)))
+          ((and (consp what) (stringp (first what)))
+           (find-file (first (slime-from-lisp-filename what)))
+           (cond
+            ((eql (second what) :charpos)
+             (goto-char (third what)))
+            (t
+             (goto-line (second what))
+             ;; Find the correct column, without going past the end of
+             ;; the line.
+             (let ((col (third what)))
+               (while (and col
+                           (< (point) (point-at-eol))
+                           (/= (decf col) -1))
+                 (forward-char 1))))))
+          ((and what (symbolp what))
+           (slime-edit-definition (symbol-name what)))
+          ((consp what)
+           (slime-edit-definition (prin1-to-string what)))
+          (t nil))))                    ; nothing in particular
+
+
+;;;; Interactive evaluation.
+
+(defun slime-interactive-eval (string)
+  "Read and evaluate STRING and print value in minibuffer.
+
+Note: If a prefix argument is in effect then the result will be
+inserted in the current buffer."
+  (interactive (list (slime-read-from-minibuffer "Slime Eval: ")))
+  (slime-insert-transcript-delimiter string)
+  (cond ((not current-prefix-arg)
+         (slime-eval-with-transcript `(swank:interactive-eval ,string) 
+                                     'slime-display-eval-result))
+        (t
+         (slime-eval-print string))))
+
+(defun slime-display-eval-result (value)
+  (slime-message "%s" value))
+
+(defun slime-eval-print (string)
+  "Eval STRING in Lisp; insert any output and the result at point."
+  (slime-eval-async `(swank:eval-and-grab-output ,string)
+                    (lexical-let ((buffer (current-buffer)))
+                      (lambda (result)
+                        (with-current-buffer buffer
+                          (destructuring-bind (output value) result
+                            (insert output value)))))))
+
+(defun slime-eval-with-transcript (form &optional fn)
+  "Send FROM and PACKAGE to Lisp and pass the result to FN.
+Display the result in the message area, if FN is nil.
+Show the output buffer if the evaluation causes any output."
+  (with-current-buffer (slime-output-buffer)
+    (slime-with-output-end-mark 
+     (slime-mark-output-start)))
+  (with-lexical-bindings (fn)
+    (slime-eval-async form
+                      (lambda (value)
+                        (with-current-buffer (slime-output-buffer)
+                          (slime-show-last-output)
+                          (cond (fn (funcall fn value))
+                                (t (message "%s" value))))))))
+
+(defun slime-eval-describe (form)
+  "Evaluate FORM in Lisp and display the result in a new buffer."
+  (lexical-let ((package (slime-current-package)))
+    (slime-eval-with-transcript
+     form (lambda (string) (slime-show-description string package)))))
+
+(defun slime-insert-transcript-delimiter (string)
+  (with-current-buffer (slime-output-buffer)
+    (slime-with-output-end-mark
+     (unless (bolp) (insert-before-markers "\n"))
+     (slime-propertize-region '(slime-transcript-delimiter t)
+       (insert-before-markers
+        ";;;; " (subst-char-in-string ?\n ?\ 
+                                      (substring string 0 
+                                                 (min 60 (length string))))
+        " ...\n")))))
+
+(defun slime-display-buffer-region (buffer start end &optional other-window)
+  "Like `display-buffer', but only display the specified region."
+  (let ((window-min-height 1))
+    (with-current-buffer buffer
+      (save-excursion
+        (save-restriction
+          (goto-char start)
+          (beginning-of-line)
+          (narrow-to-region (point) end)
+          (let ((window (display-buffer buffer other-window t)))
+            (set-window-start window (point))
+            (unless (or (one-window-p t)
+                        (/= (frame-width) (window-width)))
+              (set-window-text-height window (/ (1- (frame-height)) 2)))
+            (shrink-window-if-larger-than-buffer window)
+            window))))))
+  
+(defun slime-last-expression ()
+  (buffer-substring-no-properties
+   (save-excursion (backward-sexp) (point))
+   (point)))
+
+(defun slime-eval-last-expression ()
+  "Evaluate the expression preceding point."
+  (interactive)
+  (slime-interactive-eval (slime-last-expression)))
+
+(defun slime-eval-last-expression-display-output ()
+  "Display output buffer and evaluate the expression preceding point."
+  (interactive)
+  (slime-display-output-buffer)
+  (slime-interactive-eval (slime-last-expression)))
+  
+(defun slime-eval-defun ()
+  "Evaluate the current toplevel form.
+Use `slime-re-evaluate-defvar' if the from starts with '(defvar'"
+  (interactive)
+  (let ((form (slime-defun-at-point)))
+    (cond ((string-match "^(defvar " form)
+           (slime-re-evaluate-defvar form))
+          (t
+           (slime-interactive-eval form)))))
+
+(defun slime-eval-region (start end)
+  "Evaluate region."
+  (interactive "r")
+  (slime-eval-with-transcript
+   `(swank:interactive-eval-region 
+     ,(buffer-substring-no-properties start end))))
+
+(defun slime-eval-buffer ()
+  "Evaluate the current buffer.
+The value is printed in the echo area."
+  (interactive)
+  (slime-eval-region (point-min) (point-max)))
+
+(defun slime-re-evaluate-defvar (form)
+  "Force the re-evaluaton of the defvar form before point.  
+
+First make the variable unbound, then evaluate the entire form."
+  (interactive (list (slime-last-expression)))
+  (slime-eval-with-transcript `(swank:re-evaluate-defvar ,form)))
+
+(defun slime-pprint-eval-last-expression ()
+  "Evaluate the form before point; pprint the value in a buffer."
+  (interactive)
+  (slime-eval-describe `(swank:pprint-eval ,(slime-last-expression))))
+
+(defun slime-eval-print-last-expression (string)
+  "Evaluate sexp before point; print value into the current buffer"
+  (interactive (list (slime-last-expression)))
+  (insert "\n")
+  (slime-eval-print string))
+
+(defun slime-call-defun ()
+  "Insert a call to the function defined around point into the REPL."
+  (interactive)
+  (let ((toplevel (slime-parse-toplevel-form)))
+    (unless (and (consp toplevel)
+                 (member (car toplevel) '(:defun :defmethod :defgeneric))
+                 (symbolp (cadr toplevel)))
+      (error "Not in a function definition"))
+    (let* ((symbol (cadr toplevel))
+           (function-call 
+            (format "(%s " (slime-qualify-cl-symbol-name symbol))))
+      (slime-switch-to-output-buffer)
+      (goto-char slime-repl-input-start-mark)
+      (insert function-call)
+      (save-excursion (insert ")")))))
+
+;;;; Edit Lisp value
+;;;
+(defun slime-edit-value (form-string)
+  "\\<slime-edit-value-mode-map>\
+Edit the value of a setf'able form in a new buffer.
+The value is inserted into a temporary buffer for editing and then set
+in Lisp when committed with \\[slime-edit-value-commit]."
+  (interactive 
+   (list (slime-read-from-minibuffer "Edit value (evaluated): "
+				     (slime-sexp-at-point))))
+  (slime-eval-async `(swank:value-for-editing ,form-string)
+                    (lexical-let ((form-string form-string)
+                                  (package (slime-current-package)))
+                      (lambda (result)
+                        (slime-edit-value-callback form-string result 
+                                                   package)))))
+
+(make-variable-buffer-local
+ (defvar slime-edit-form-string nil
+   "The form being edited by `slime-edit-value'."))
+
+(define-minor-mode slime-edit-value-mode
+  "Mode for editing a Lisp value."
+  nil
+  " edit"
+  '(("\C-c\C-c" . slime-edit-value-commit)))
+
+(defun slime-edit-value-callback (form-string current-value package)
+  (let ((name (generate-new-buffer-name (format "*Edit %s*" form-string))))
+    (with-current-buffer (slime-get-temp-buffer-create name :mode 'lisp-mode)
+      (slime-mode 1)
+      (slime-temp-buffer-mode -1)       ; don't want binding of 'q'
+      (slime-edit-value-mode 1)
+      (setq slime-edit-form-string form-string)
+      (setq slime-buffer-connection (slime-connection))
+      (setq slime-buffer-package package)
+      (insert current-value))))
+
+(defun slime-edit-value-commit ()
+  "Commit the edited value to the Lisp image.
+\\(See `slime-edit-value'.)"
+  (interactive)
+  (if (null slime-edit-form-string)
+      (error "Not editing a value.")
+    (let ((value (buffer-substring-no-properties (point-min) (point-max))))
+      (lexical-let ((buffer (current-buffer)))
+        (slime-eval-async `(swank:commit-edited-value ,slime-edit-form-string
+                                                      ,value)
+                          (lambda (_)
+                            (with-current-buffer buffer
+                              (slime-temp-buffer-quit t))))))))
+
+;;;; Tracing
+
+(defun slime-redirect-trace-output ()
+  "Redirect the trace output to a separate Emacs buffer."
+  (interactive)
+  (let ((buffer (get-buffer-create "*SLIME Trace Output*")))
+    (with-current-buffer buffer
+      (let ((marker (copy-marker (buffer-size)))
+            (target (incf slime-last-output-target-id)))
+        (puthash target marker slime-output-target-to-marker)
+        (slime-eval `(swank:redirect-trace-output ,target))))
+    ;; Note: We would like the entries in
+    ;; slime-output-target-to-marker to disappear when the buffers are
+    ;; killed.  We cannot just make the hash-table ":weakness 'value"
+    ;; -- there is no reference from the buffers to the markers in the
+    ;; buffer, so entries would disappear even though the buffers are
+    ;; alive.  Best solution might be to make buffer-local variables
+    ;; that keep the markers. --mkoeppe
+    (pop-to-buffer buffer)))
+
+(defun slime-untrace-all ()
+  "Untrace all functions."
+  (interactive)
+  (slime-eval `(swank:untrace-all)))
+
+(defun slime-toggle-trace-fdefinition (&optional using-context-p)
+  "Toggle trace."
+  (interactive "P")
+  (let* ((spec (if using-context-p
+                  (slime-extract-context)
+                 (slime-symbol-name-at-point)))
+         (spec (slime-trace-query spec)))
+    (message "%s" (slime-eval `(swank:swank-toggle-trace ,spec)))))
+
+(defun slime-trace-query (spec)
+  "Ask the user which function to trace; SPEC is the default.
+The result is a string."
+  (cond ((null spec)
+         (slime-read-from-minibuffer "(Un)trace: "))
+        ((stringp spec)
+         (slime-read-from-minibuffer "(Un)trace: " spec))
+        (t
+         (destructure-case spec
+           ((setf n)
+            (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
+           (((:defun :defmacro) n)
+            (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string n)))
+           ((:defgeneric n)
+            (let* ((name (prin1-to-string n))
+                   (answer (slime-read-from-minibuffer "(Un)trace: " name)))
+              (cond ((and (string= name answer)
+                          (y-or-n-p (concat "(Un)trace also all " 
+                                            "methods implementing " 
+                                            name "? ")))
+                     (prin1-to-string `(:defgeneric ,n)))
+                    (t
+                     answer))))
+           ((:defmethod &rest _)
+            (slime-read-from-minibuffer "(Un)trace: " (prin1-to-string spec)))
+           ((:call caller callee)
+            (let* ((callerstr (prin1-to-string caller))
+                   (calleestr (prin1-to-string callee))
+                   (answer (slime-read-from-minibuffer "(Un)trace: " 
+                                                       calleestr)))
+              (cond ((and (string= calleestr answer)
+                          (y-or-n-p (concat "(Un)trace only when " calleestr
+                                            " is called by " callerstr "? ")))
+                     (prin1-to-string `(:call ,caller ,callee)))
+                    (t
+                     answer))))
+           (((:labels :flet) &rest _)
+            (slime-read-from-minibuffer "(Un)trace local function: "
+                                        (prin1-to-string spec)))))))
+
+(defun slime-extract-context ()
+  "Parse the context for the symbol at point.  
+Nil is returned if there's no symbol at point.  Otherwise we detect
+the following cases (the . shows the point position):
+
+ (defun n.ame (...) ...)                 -> (:defun name)
+ (defun (setf n.ame) (...) ...)          -> (:defun (setf name))
+ (defmethod n.ame (...) ...)             -> (:defmethod name (...))
+ (defun ... (...) (labels ((n.ame (...)  -> (:labels (:defun ...) name)
+ (defun ... (...) (flet ((n.ame (...)    -> (:flet (:defun ...) name)
+ (defun ... (...) ... (n.ame ...) ...)   -> (:call (:defun ...) name)
+ (defun ... (...) ... (setf (n.ame ...)  -> (:call (:defun ...) (setf name))
+
+For other contexts we return the symbol at point."
+  (let ((name (slime-symbol-name-at-point)))
+    (if name
+        (let ((symbol (read name)))
+          (or (progn ;;ignore-errors 
+                (slime-parse-context symbol))
+              symbol)))))
+
+(defun slime-parse-context (name)
+  (save-excursion 
+    (cond ((slime-in-expression-p '(defun *))          `(:defun ,name))
+          ((slime-in-expression-p '(defmacro *))       `(:defmacro ,name))
+          ((slime-in-expression-p '(defgeneric *))     `(:defgeneric ,name))
+          ((slime-in-expression-p '(setf *))
+           ;;a setf-definition, but which?
+           (backward-up-list 1)
+           (slime-parse-context `(setf ,name)))
+          ((slime-in-expression-p '(defmethod *))
+           (unless (looking-at "\\s ")
+             (forward-sexp 1)) ; skip over the methodname
+           (let (qualifiers arglist)
+             (loop for e = (read (current-buffer))
+                   until (listp e) do (push e qualifiers)
+                   finally (setq arglist e))
+             `(:defmethod ,name , at qualifiers
+                          ,(slime-arglist-specializers arglist))))
+          ((and (symbolp name) 
+                (slime-in-expression-p `(,name)))
+           ;; looks like a regular call
+           (let ((toplevel (ignore-errors (slime-parse-toplevel-form))))
+             (cond ((slime-in-expression-p `(setf (*)))  ;a setf-call
+                    (if toplevel
+                        `(:call ,toplevel (setf ,name))
+                      `(setf ,name)))
+                   ((not toplevel)
+                    name)
+                   ((slime-in-expression-p `(labels ((*))))
+                    `(:labels ,toplevel ,name))
+                   ((slime-in-expression-p `(flet ((*))))
+                    `(:flet ,toplevel ,name))
+                   (t
+                    `(:call ,toplevel ,name)))))
+          (t 
+           name))))
+
+(defun slime-in-expression-p (pattern)
+  "A helper function to determine the current context.
+The pattern can have the form:
+ pattern ::= ()    ;matches always
+           | (*)   ;matches inside a list
+           | (<symbol> <pattern>)   ;matches if the first element in
+				    ; the current list is <symbol> and
+                                    ; if <pattern> matches.
+           | ((<pattern>))          ;matches if we are in a nested list."
+  (save-excursion
+    (let ((path (reverse (slime-pattern-path pattern))))
+      (loop for p in path
+            always (ignore-errors 
+                     (etypecase p
+                       (symbol (slime-beginning-of-list) 
+                               (eq (read (current-buffer)) p))
+                       (number (backward-up-list p)
+                               t)))))))
+
+(defun slime-pattern-path (pattern)
+  ;; Compute the path to the * in the pattern to make matching
+  ;; easier. The path is a list of symbols and numbers.  A number
+  ;; means "(down-list <n>)" and a symbol "(look-at <sym>)")
+  (if (null pattern)
+      '()
+    (etypecase (car pattern)
+      ((member *) '())
+      (symbol (cons (car pattern) (slime-pattern-path (cdr pattern))))
+      (cons (cons 1 (slime-pattern-path (car pattern)))))))
+
+(defun slime-beginning-of-list (&optional up)
+  "Move backward the the beginning of the current expression.
+Point is placed before the first expression in the list."
+  (backward-up-list (or up 1))
+  (down-list 1)
+  (skip-syntax-forward " "))
+
+(defun slime-parse-toplevel-form ()
+  (save-excursion
+    (beginning-of-defun)
+    (down-list 1)
+    (forward-sexp 1)
+    (slime-parse-context (read (current-buffer)))))
+		 
+(defun slime-arglist-specializers (arglist)
+  (cond ((or (null arglist)
+	     (member (first arglist) '(&optional &key &rest &aux)))
+	 (list))
+	((consp (first arglist))
+	 (cons (second (first arglist))
+	       (slime-arglist-specializers (rest arglist))))
+	(t
+	 (cons 't 
+	       (slime-arglist-specializers (rest arglist))))))
+
+(defun slime-disassemble-symbol (symbol-name)
+  "Display the disassembly for SYMBOL-NAME."
+  (interactive (list (slime-read-symbol-name "Disassemble: ")))
+  (slime-eval-describe `(swank:disassemble-symbol ,symbol-name)))
+
+(defun slime-undefine-function (symbol-name)
+  "Unbind the function slot of SYMBOL-NAME."
+  (interactive (list (slime-read-symbol-name "fmakunbound: " t)))
+  (slime-eval-async `(swank:undefine-function ,symbol-name)
+                    (lambda (result) (message "%s" result))))
+
+(defun slime-load-file (filename)
+  "Load the Lisp file FILENAME."
+  (interactive (list 
+		(read-file-name "Load file: " nil nil
+				nil (if (buffer-file-name)
+                                        (file-name-nondirectory 
+                                         (buffer-file-name))))))
+  (let ((lisp-filename (slime-to-lisp-filename (expand-file-name filename))))
+    (slime-eval-with-transcript `(swank:load-file ,lisp-filename))))
+
+
+
+
+;;;; Profiling
+
+(defun slime-toggle-profile-fdefinition (fname-string)
+  "Toggle profiling for FNAME-STRING."
+  (interactive (list (slime-read-from-minibuffer 
+                      "(Un)Profile: "
+                      (slime-symbol-name-at-point))))
+  (slime-eval-async `(swank:toggle-profile-fdefinition ,fname-string)
+                    (lambda (r) (message "%s" r))))
+
+(defun slime-unprofile-all ()
+  "Unprofile all functions."
+  (interactive)
+  (slime-eval-async '(swank:unprofile-all)
+                    (lambda (r) (message "%s" r))))
+
+(defun slime-profile-report ()
+  "Print profile report."
+  (interactive)
+  (slime-eval-with-transcript '(swank:profile-report)))
+
+(defun slime-profile-reset ()
+  "Reset profile counters."
+  (interactive)
+  (slime-eval-async (slime-eval `(swank:profile-reset))
+                    (lambda (r) (message "%s" r))))
+
+(defun slime-profiled-functions ()
+  "Return list of names of currently profiled functions."
+  (interactive)
+  (slime-eval-async `(swank:profiled-functions)
+                    (lambda (r) (message "%s" r))))
+
+(defun slime-profile-package (package callers methods)
+  "Profile all functions in PACKAGE.  
+If CALLER is non-nil names have counts of the most common calling
+functions recorded. 
+If METHODS is non-nil, profile all methods of all generic function
+having names in the given package."
+  (interactive (list (slime-read-package-name "Package: ")
+                     (y-or-n-p "Record the most common callers? ")
+                     (y-or-n-p "Profile methods? ")))
+  (slime-eval-async `(swank:profile-package ,package ,callers ,methods)
+                    (lambda (r) (message "%s" r))))
+
+
+
+;;;; Documentation
+
+(defun slime-hyperspec-lookup (symbol-name)
+  "A wrapper for `hyperspec-lookup'"
+  (interactive (list (let* ((symbol-at-point (slime-symbol-name-at-point))
+                            (stripped-symbol 
+                             (and symbol-at-point
+                                  (downcase
+                                   (common-lisp-hyperspec-strip-cl-package 
+                                    symbol-at-point)))))
+                       (if (and stripped-symbol
+                                (intern-soft stripped-symbol
+                                             common-lisp-hyperspec-symbols))
+                           stripped-symbol
+                         (completing-read
+                          "Look up symbol in Common Lisp HyperSpec: "
+                          common-lisp-hyperspec-symbols #'boundp
+                          t stripped-symbol
+                          'common-lisp-hyperspec-history)))))
+  (hyperspec-lookup symbol-name))
+  
+(defun slime-show-description (string package)
+  (slime-with-output-to-temp-buffer ("*SLIME Description*")
+      package (princ string)))
+
+(defun slime-describe-symbol (symbol-name)
+  "Describe the symbol at point."
+  (interactive (list (slime-read-symbol-name "Describe symbol: ")))
+  (when (not symbol-name)
+    (error "No symbol given"))
+  (slime-eval-describe `(swank:describe-symbol ,symbol-name)))
+
+(defun slime-documentation (symbol-name)
+  "Display function- or symbol-documentation for SYMBOL-NAME."
+  (interactive (list (slime-read-symbol-name "Documentation for symbol: ")))
+  (when (not symbol-name)
+    (error "No symbol given"))
+  (slime-eval-describe 
+   `(swank:documentation-symbol ,symbol-name "(not documented)")))
+
+(defun slime-describe-function (symbol-name)
+  (interactive (list (slime-read-symbol-name "Describe symbol: ")))
+  (when (not symbol-name)
+    (error "No symbol given"))
+  (slime-eval-describe `(swank:describe-function ,symbol-name)))
+
+(defun slime-apropos-summary (string case-sensitive-p package only-external-p)
+  "Return a short description for the performed apropos search."
+  (concat (if case-sensitive-p "Case-sensitive " "")
+          "Apropos for "
+          (format "%S" string)
+          (if package (format " in package %S" package) "")
+          (if only-external-p " (external symbols only)" "")))
+
+(defun slime-apropos (string &optional only-external-p package 
+                             case-sensitive-p)
+  "Show all bound symbols whose names match STRING, a regular expression."
+  (interactive
+   (if current-prefix-arg
+       (list (read-string "SLIME Apropos: ")
+             (y-or-n-p "External symbols only? ")
+             (let ((pkg (slime-read-package-name "Package: ")))
+               (if (string= pkg "") nil pkg))
+             (y-or-n-p "Case-sensitive? "))
+     (list (read-string "SLIME Apropos: ") t nil nil)))
+  (let ((buffer-package (or package (slime-current-package))))
+    (slime-eval-async
+     `(swank:apropos-list-for-emacs ,string ,only-external-p
+                                    ,case-sensitive-p ',package)
+     (lexical-let ((string string)
+                   (package buffer-package)
+                   (summary (slime-apropos-summary string case-sensitive-p
+                                                   package only-external-p)))
+       (lambda (r) (slime-show-apropos r string package summary))))))
+
+(defun slime-apropos-all ()
+  "Shortcut for (slime-apropos <pattern> nil nil)"
+  (interactive)
+  (slime-apropos (read-string "SLIME Apropos: ") nil nil))
+
+(defun slime-apropos-package (package &optional internal)
+  "Show apropos listing for symbols in PACKAGE.
+With prefix argument include internal symbols."
+  (interactive (list (let ((pkg (slime-read-package-name "Package: ")))
+                       (if (string= pkg "") (slime-current-package) pkg))
+                     current-prefix-arg))
+  (slime-apropos "" (not internal) package))
+
+(defun slime-show-apropos (plists string package summary)
+  (if (null plists)
+      (message "No apropos matches for %S" string)
+    (slime-with-output-to-temp-buffer ("*SLIME Apropos*" :mode apropos-mode)
+        package
+      (set-syntax-table lisp-mode-syntax-table)
+      (slime-mode t)
+      (if (boundp 'header-line-format)
+          (setq header-line-format summary)
+        (insert summary "\n\n"))
+      (slime-set-truncate-lines)
+      (slime-print-apropos plists))))
+
+(defvar slime-apropos-label-properties
+  (progn
+    (require 'apropos)
+    (cond ((and (boundp 'apropos-label-properties) 
+                (symbol-value 'apropos-label-properties)))
+          ((boundp 'apropos-label-face)
+           (etypecase (symbol-value 'apropos-label-face)
+             (symbol `(face ,(or (symbol-value 'apropos-label-face)
+                                 'italic)
+                            mouse-face highlight))
+             (list (symbol-value 'apropos-label-face)))))))
+
+(eval-when-compile (require 'apropos))
+
+(defun slime-print-apropos (plists)
+  (dolist (plist plists)
+    (let ((designator (plist-get plist :designator)))
+      (assert designator)
+      (slime-insert-propertized (list 'face apropos-symbol-face
+                                      'item designator
+                                      'action 'slime-describe-symbol)
+                                designator))
+    (terpri)
+    (let ((apropos-label-properties slime-apropos-label-properties))
+      (loop for (prop namespace) 
+	    in '((:variable "Variable")
+		 (:function "Function")
+		 (:generic-function "Generic Function")
+                 (:macro "Macro")
+                 (:special-operator "Special Operator")
+		 (:setf "Setf")
+		 (:type "Type")
+		 (:class "Class")
+                 (:alien-type "Alien type")
+                 (:alien-struct "Alien struct")
+                 (:alien-union "Alien type")
+                 (:alien-enum "Alien enum"))
+            ;; Properties not listed here will not show up in the buffer
+	    do
+	    (let ((value (plist-get plist prop))
+		  (start (point)))
+	      (when value
+		(princ "  ") 
+		(slime-insert-propertized apropos-label-properties namespace)
+		(princ ": ")
+		(princ (etypecase value
+			 (string value)
+			 ((member :not-documented) "(not documented)")))
+                (add-text-properties 
+                 start (point)
+                 (list 'type prop 'action 'slime-call-describer
+                       'button t 'apropos-label namespace 
+                       'item (plist-get plist :designator)))
+		(terpri)))))))
+
+(defun slime-call-describer (arg)
+  (let* ((pos (if (markerp arg) arg (point)))
+         (type (get-text-property pos 'type))
+         (item (get-text-property pos 'item)))
+    (slime-eval-describe `(swank:describe-definition-for-emacs ,item ,type))))
+
+
+;;;; XREF: cross-referencing
+
+(defvar slime-xref-mode-map)
+(defvar slime-xref-saved-emacs-snapshot nil
+  "Buffer local variable in xref windows.")
+
+(define-derived-mode slime-xref-mode lisp-mode "xref"
+  "slime-xref-mode: Major mode for cross-referencing.
+\\<slime-xref-mode-map>\
+The most important commands:
+\\[slime-xref-quit]	- Dismiss buffer.
+\\[slime-show-xref]	- Display referenced source and keep xref window.
+\\[slime-goto-xref]	- Jump to referenced source and dismiss xref window.
+
+\\{slime-xref-mode-map}"
+  (setq font-lock-defaults nil)
+  (setq delayed-mode-hooks nil)
+  (slime-mode -1))
+
+(slime-define-keys slime-xref-mode-map 
+  ((kbd "RET") 'slime-show-xref)
+  ("\C-m" 'slime-show-xref)
+  (" " 'slime-goto-xref)
+  ("q" 'slime-xref-quit)
+  ("n" 'slime-next-line/not-add-newlines)
+  ("p" 'previous-line))
+
+(defun slime-next-line/not-add-newlines ()
+  (interactive)
+  (let ((next-line-add-newlines nil))
+    (next-line 1)))
+
+;; FIXME: binding SLDB keys in xref buffer? -luke
+(dolist (spec slime-keys)
+  (destructuring-bind (key command &key sldb prefixed &allow-other-keys) spec
+    (when sldb
+      (let ((key (if prefixed (concat slime-prefix-key key) key)))
+        (define-key slime-xref-mode-map key command)))))
+
+
+;;;;; XREF results buffer and window management
+
+(defun slime-xref-buffer ()
+  "Return the XREF results buffer.
+If CREATE is non-nil, create it if necessary."
+  (or (find-if (lambda (b) (string-match "*XREF\\[" (buffer-name b)))
+               (buffer-list))
+      (error "No XREF buffer")))
+
+(defun slime-init-xref-buffer (package ref-type symbol)
+  "Initialize the current buffer for displaying XREF information."
+  (slime-xref-mode)
+  (setq buffer-read-only nil)
+  (erase-buffer)
+  (setq slime-buffer-package package)
+  (slime-set-truncate-lines))
+
+;; XXX: unused function
+(defun slime-display-xref-buffer ()
+  "Display the XREF results buffer in a window and select it."
+  (let* ((buffer (slime-xref-buffer))
+         (window (get-buffer-window buffer)))
+    (if (and window (window-live-p window))
+        (select-window window)
+      (select-window (display-buffer buffer t))
+      (shrink-window-if-larger-than-buffer))))
+
+(defmacro* slime-with-xref-buffer ((package ref-type symbol &key emacs-snapshot) 
+                                   &body body)
+  "Execute BODY in a xref buffer, then show that buffer."
+  (let ((type (gensym "TYPE+")) (sym      (gensym "SYM+"))
+        (pkg  (gensym "PKG+"))  (snapshot (gensym "SNAPSHOT+")))
+    `(let ((,type ,ref-type) (,sym ,symbol) (,pkg ,package))
+       ;; We don't want the the xref buffer to be the current buffer
+       ;; in the snapshot, so we gotta take the snapshot here.
+       (let ((,snapshot (or ,emacs-snapshot (slime-current-emacs-snapshot))))
+         (with-current-buffer (get-buffer-create 
+                               (format "*XREF[%s: %s]*" ,type ,sym))
+           (prog2 (progn
+                    (slime-init-xref-buffer ,pkg ,type ,sym)
+                    (make-local-variable 'slime-xref-saved-emacs-snapshot)
+                    (setq slime-xref-saved-emacs-snapshot ,snapshot))
+               (progn , at body)
+             (setq buffer-read-only t)
+             (select-window (or (get-buffer-window (current-buffer) t)
+                                (display-buffer (current-buffer) t)))
+             (shrink-window-if-larger-than-buffer)))))))
+
+(put 'slime-with-xref-buffer 'lisp-indent-function 1)
+
+(defun slime-insert-xrefs (xrefs)
+  "Insert XREFS in the current-buffer.
+XREFS is a list of the form ((GROUP . ((LABEL . LOCATION) ...)) ...)
+GROUP and LABEL are for decoration purposes.  LOCATION is a source-location."
+  (unless (bobp) (insert "\n"))
+  (loop for (group . refs) in xrefs do 
+        (progn
+          (slime-insert-propertized '(face bold) group "\n")
+          (loop
+             for (label . location) in refs 
+             do (slime-insert-propertized 
+                 (list 'slime-location location
+                       'face 'font-lock-keyword-face)
+                 "  " (slime-one-line-ify label))
+             do (insert " - " (if (and (eql :location (car location))
+                                       (assoc :file (cdr location)))
+                                  (second (assoc :file (cdr location)))
+                                  "file unknown")
+                          "\n"))))
+  ;; Remove the final newline to prevent accidental window-scrolling
+  (backward-char 1)
+  (delete-char 1))
+
+(defvar slime-next-location-function nil
+  "Function to call for going to the next location.")
+
+(defun slime-show-xrefs (xrefs type symbol package &optional emacs-snapshot)
+  "Show the results of an XREF query."
+  (if (null xrefs)
+      (message "No references found for %s." symbol)
+    (setq slime-next-location-function 'slime-goto-next-xref)
+    (slime-with-xref-buffer (package type symbol :emacs-snapshot emacs-snapshot)
+      (slime-insert-xrefs xrefs)
+      (goto-char (point-min))
+      (forward-line)
+      (skip-chars-forward " \t"))))
+
+
+;;;;; XREF commands
+
+(defun slime-who-calls (symbol)
+  "Show all known callers of the function SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who calls: " t)))
+  (slime-xref :calls symbol))
+
+(defun slime-calls-who (symbol)
+  "Show all known functions called by the function SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who calls: " t)))
+  (slime-xref :calls-who symbol))
+
+(defun slime-who-references (symbol)
+  "Show all known referrers of the global variable SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who references: " t)))
+  (slime-xref :references symbol))
+
+(defun slime-who-binds (symbol)
+  "Show all known binders of the global variable SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who binds: " t)))
+  (slime-xref :binds symbol))
+
+(defun slime-who-sets (symbol)
+  "Show all known setters of the global variable SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who sets: " t)))
+  (slime-xref :sets symbol))
+
+(defun slime-who-macroexpands (symbol)
+  "Show all known expanders of the macro SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who macroexpands: " t)))
+  (slime-xref :macroexpands symbol))
+
+(defun slime-who-specializes (symbol)
+  "Show all known methods specialized on class SYMBOL."
+  (interactive (list (slime-read-symbol-name "Who specializes: " t)))
+  (slime-xref :specializes symbol))
+
+(defun slime-list-callers (symbol-name)
+  "List the callers of SYMBOL-NAME in a xref window."
+  (interactive (list (slime-read-symbol-name "List callers: ")))
+  (slime-xref :callers symbol-name))
+
+(defun slime-list-callees (symbol-name)
+  "List the callees of SYMBOL-NAME in a xref window."
+  (interactive (list (slime-read-symbol-name "List callees: ")))
+  (slime-xref :callees symbol-name))
+
+(defun slime-xref (type symbol)
+  "Make an XREF request to Lisp."
+  (slime-eval-async
+   `(swank:xref ',type ',symbol)
+   (lexical-let ((type type)
+                 (symbol symbol)
+                 (package (slime-current-package))
+                 ;; We have to take the snapshot here, because SLIME-EVAL-ASYNC
+                 ;; is invoking its continuation within the extent of a different
+                 ;; buffer. (2007-08-14)
+                 (snapshot (slime-current-emacs-snapshot)))
+     (lambda (result)
+       (slime-show-xrefs result type symbol package snapshot)))))
+
+
+;;;;; XREF navigation
+
+(defun slime-xref-location-at-point ()
+  (save-excursion
+    ;; When the end of the last line is at (point-max) we can't find
+    ;; the text property there. Going to bol avoids this problem.
+    (beginning-of-line 1)
+    (or (get-text-property (point) 'slime-location)
+        (error "No reference at point."))))
+
+(defun slime-goto-xref ()
+  "Goto the cross-referenced location at point."
+  (interactive)
+  (let ((location (slime-xref-location-at-point)))
+    (slime-xref-cleanup)
+    (slime-goto-source-location location)
+    (switch-to-buffer (current-buffer))))
+
+(defun slime-show-xref ()
+  "Display the xref at point in the other window."
+  (interactive)
+  (let ((location (slime-xref-location-at-point)))
+    (slime-show-source-location location)))
+      
+(defun slime-goto-next-xref ()
+  "Goto the next cross-reference location."
+  (let ((location (with-current-buffer (slime-xref-buffer)
+                    (let ((w (display-buffer (current-buffer) t)))
+                      (goto-char (1+ (next-single-char-property-change 
+                                      (point) 'slime-location)))
+                      (set-window-point w (point)))
+                    (cond ((eobp)
+                           (message "No more xrefs.")
+                           nil)
+                          (t 
+                           (slime-xref-location-at-point))))))
+    (when location
+      (slime-goto-source-location location)
+      (switch-to-buffer (current-buffer)))))
+
+(defun slime-next-location ()
+  "Go to the next location, depending on context.
+When displaying XREF information, this goes to the next reference."
+  (interactive)
+  (when (null slime-next-location-function)
+    (error "No context for finding locations."))
+  (funcall slime-next-location-function))
+
+(defun slime-xref-quit ()
+  "Kill the current xref buffer and restore the window configuration."
+  (interactive)
+  (let ((snapshot slime-xref-saved-emacs-snapshot))
+    (slime-xref-cleanup)
+    (slime-set-emacs-snapshot snapshot)))
+
+(defun slime-xref-cleanup ()
+  "Delete overlays created by xref mode and kill the xref buffer."
+  (sldb-delete-overlays)
+  (let ((buffer (current-buffer)))
+    (delete-windows-on buffer)
+    (kill-buffer buffer)))
+
+
+;;;; Macroexpansion
+
+(define-minor-mode slime-macroexpansion-minor-mode
+    "SLIME mode for macroexpansion"
+    nil
+  " temp"
+  '(("q" . slime-temp-buffer-quit)
+    ("g" . slime-macroexpand-again)))
+
+(flet ((remap (from to)
+         (dolist (mapping (where-is-internal from slime-mode-map))
+           (define-key slime-macroexpansion-minor-mode-map mapping to))))
+  (remap 'slime-macroexpand-1 'slime-macroexpand-1-inplace)
+  (remap 'slime-macroexpand-all 'slime-macroexpand-all-inplace)
+  (remap 'undo '(lambda (&optional arg)
+                 (interactive)
+                 (let ((buffer-read-only nil))
+                   (when (fboundp 'slime-remove-edits)
+                     (slime-remove-edits (point-min) (point-max)))
+                   (undo arg)))))
+
+(defun slime-sexp-at-point-for-macroexpansion ()
+  "Essentially like SLIME-SEXP-AT-POINT-OR-ERROR, but behaves a
+bit more sanely in situations like ,(loop ...) where you want to
+expand the LOOP form. See comment in the source of this function."
+  (let ((string (slime-sexp-at-point-or-error))
+        (bounds (bounds-of-thing-at-point 'sexp))
+        (char-at-point (substring-no-properties (thing-at-point 'char))))
+    ;; SLIME-SEXP-AT-POINT(-OR-ERROR) uses (THING-AT-POINT 'SEXP)
+    ;; which is quite a bit botched: it returns "'(FOO BAR BAZ)" even
+    ;; when point is placed _at the opening parenthesis_, and hence
+    ;; "(FOO BAR BAZ)" wouldn't get expanded. Likewise for ",(...)",
+    ;; ",@(...)" (would return "@(...)"!!), and "\"(...)".
+    ;; So we better fix this up here:
+    (when (string= char-at-point "(")
+      (let ((char0 (elt string 0)))
+        (when (member char0 '(?\' ?\, ?\" ?\@))
+          (setf string (substring string 1))
+          (incf (car bounds)))))
+    (list string bounds)))
+
+(defvar slime-eval-macroexpand-expression nil
+  "Specifies the last macroexpansion preformed. This variable
+  specifies both what was expanded and how.")
+
+(defun slime-eval-macroexpand (expander &optional string)
+  (unless string
+    (setf string (first (slime-sexp-at-point-for-macroexpansion))))
+  (setf slime-eval-macroexpand-expression `(,expander ,string))
+  (lexical-let ((package (slime-current-package)))
+    (slime-eval-async 
+     slime-eval-macroexpand-expression
+     (lambda (expansion)
+       (slime-with-output-to-temp-buffer
+           ;; reusep for preserving `undo' functionality.
+           ("*SLIME macroexpansion*" :mode lisp-mode :reusep t) package
+         (slime-macroexpansion-minor-mode)
+         (erase-buffer)
+         (insert expansion)
+         (font-lock-fontify-buffer))))))
+
+(defun slime-eval-macroexpand-inplace (expander)
+  "Substitutes the current sexp at place with its macroexpansion.
+
+NB: Does not affect *slime-eval-macroexpand-expression*"
+  (interactive)
+  (destructuring-bind (string bounds)
+      (slime-sexp-at-point-for-macroexpansion)
+    (lexical-let* ((start (car bounds))
+                   (end (cdr bounds))
+                   (point (point))
+                   (package (slime-current-package))
+                   (buffer (current-buffer)))
+      (slime-eval-async 
+       `(,expander ,string)
+       (lambda (expansion)
+         (with-current-buffer buffer
+           (let ((buffer-read-only nil))
+             (when (fboundp 'slime-remove-edits)
+               (slime-remove-edits (point-min) (point-max)))
+             (goto-char start)
+             (delete-region start end)
+             (insert expansion)
+             (goto-char start)
+             (indent-sexp)
+             (goto-char point))))))))
+
+(defun slime-macroexpand-1 (&optional repeatedly)
+  "Display the macro expansion of the form at point.  The form is
+expanded with CL:MACROEXPAND-1 or, if a prefix argument is given, with
+CL:MACROEXPAND."
+  (interactive "P")
+  (slime-eval-macroexpand
+   (if repeatedly 'swank:swank-macroexpand 'swank:swank-macroexpand-1)))
+
+(defun slime-macroexpand-1-inplace (&optional repeatedly)
+  (interactive "P")
+  (slime-eval-macroexpand-inplace
+   (if repeatedly 'swank:swank-macroexpand 'swank:swank-macroexpand-1)))
+
+(defun slime-macroexpand-all ()
+  "Display the recursively macro expanded sexp at point."
+  (interactive)
+  (slime-eval-macroexpand 'swank:swank-macroexpand-all))
+
+(defun slime-macroexpand-all-inplace ()
+  "Display the recursively macro expanded sexp at point."
+  (interactive)
+  (slime-eval-macroexpand-inplace 'swank:swank-macroexpand-all))
+
+(defun slime-compiler-macroexpand ()
+  "Display the compiler-macro expansion of sexp at point."
+  (interactive)
+  (slime-eval-macroexpand 'swank:swank-compiler-macroexpand))
+
+(defun slime-compiler-macroexpand-1 ()
+  "Display the compiler-macro expansion of sexp at point."
+  (interactive)
+  (slime-eval-macroexpand 'swank:swank-compiler-macroexpand-1))
+
+(defun slime-macroexpand-again ()
+  "Reperform the last macroexpansion."
+  (interactive)
+  (slime-eval-macroexpand (first slime-eval-macroexpand-expression)
+                          (second slime-eval-macroexpand-expression)))
+
+
+;;;; Subprocess control
+
+(defun slime-interrupt ()
+  "Interrupt Lisp."
+  (interactive)
+  (cond ((slime-use-sigint-for-interrupt) (slime-send-sigint))
+        (t (slime-dispatch-event `(:emacs-interrupt ,slime-current-thread)))))
+
+(defun slime-quit ()
+  (error "Not implemented properly.  Use `slime-interrupt' instead."))
+
+(defun slime-quit-lisp (&optional keep-buffers)
+  "Quit lisp, kill the inferior process and associated buffers."
+  (interactive)
+  (slime-eval-async '(swank:quit-lisp))
+  (kill-buffer (slime-output-buffer))
+  (set-process-filter (slime-connection) nil)
+  (set-process-sentinel (slime-connection) 'slime-quit-sentinel))
+
+(defun slime-quit-sentinel (process message)
+  (assert (process-status process) 'closed)
+  (let* ((inferior (slime-inferior-process process))
+         (inferior-buffer (if inferior (process-buffer inferior))))
+    (when inferior (delete-process inferior))
+    (when inferior-buffer (kill-buffer inferior-buffer))
+    (slime-net-close process)
+    (message "Connection closed.")))
+
+(defun slime-set-package (package)
+  (interactive (list (slime-read-package-name "Package: " 
+					      (slime-find-buffer-package))))
+  (message "*package*: %s" (slime-eval `(swank:set-package ,package))))
+
+(defun slime-set-default-directory (directory)
+  "Make DIRECTORY become Lisp's current directory."
+  (interactive (list (read-directory-name "Directory: " nil nil t)))
+  (message "default-directory: %s"
+           (slime-from-lisp-filename
+            (slime-eval `(swank:set-default-directory
+                          ,(slime-to-lisp-filename directory)))))
+  (with-current-buffer (slime-output-buffer)
+    (setq default-directory (expand-file-name directory))))
+
+(defun slime-sync-package-and-default-directory ()
+  "Set Lisp's package and directory to the values in current buffer."
+  (interactive)
+  (let ((package (slime-eval `(swank:set-package 
+			       ,(slime-find-buffer-package))))
+	(directory (slime-from-lisp-filename
+                    (slime-eval `(swank:set-default-directory 
+                                  ,(slime-to-lisp-filename
+                                    default-directory))))))
+    (let ((dir default-directory))
+      ;; Sync REPL dir
+      (with-current-buffer (slime-output-buffer)
+        (setq default-directory dir))
+      ;; Sync *inferior-lisp* dir
+      (let* ((proc (slime-process))
+             (buffer (and proc (process-buffer proc))))
+        (when buffer 
+          (with-current-buffer buffer
+            (setq default-directory dir)))))
+    (message "package: %s  default-directory: %s" (car package) directory)))
+	
+
+;;;; Debugger (SLDB)
+
+(defvar sldb-hook nil
+  "Hook run on entry to the debugger.")
+
+
+;;;;; Local variables in the debugger buffer
+
+(slime-make-variables-buffer-local
+ (defvar sldb-condition nil
+   "A list (DESCRIPTION TYPE) describing the condition being debugged.")
+
+ (defvar sldb-saved-window-configuration nil
+   "Window configuration before the debugger was initially entered.")
+
+ (defvar sldb-restarts nil
+   "List of (NAME DESCRIPTION) for each available restart.")
+
+ (defvar sldb-level nil
+   "Current debug level (recursion depth) displayed in buffer.")
+
+ (defvar sldb-backtrace-start-marker nil
+   "Marker placed at the beginning of the backtrace text.")
+
+ (defvar sldb-continuations nil
+   "List of ids for pending continuation."))
+
+;;;;; SLDB macros
+
+;; some macros that we need to define before the first use
+
+(defmacro in-sldb-face (name string)
+  "Return STRING propertised with face sldb-NAME-face."
+  (let ((facename (intern (format "sldb-%s-face" (symbol-name name))))
+	(var (gensym "string")))
+    `(let ((,var ,string))
+      (slime-add-face ',facename ,var)
+      ,var)))
+
+(put 'in-sldb-face 'lisp-indent-function 1)
+
+(defun slime-add-face (face string)
+  (add-text-properties 0 (length string) (list 'face face) string)
+  string)
+
+
+;;;;; sldb-mode
+
+(defvar sldb-mode-syntax-table
+  (let ((table (copy-syntax-table lisp-mode-syntax-table)))
+    ;; We give < and > parenthesis syntax, so that #< ... > is treated
+    ;; as a balanced expression.  This enables autodoc-mode to match
+    ;; #<unreadable> actual arguments in the backtraces with formal
+    ;; arguments of the function.  (For Lisp mode, this is not
+    ;; desirable, since we do not wish to get a mismatched paren
+    ;; highlighted everytime we type < or >.)
+    (modify-syntax-entry ?< "(" table)
+    (modify-syntax-entry ?> ")" table)
+    table)
+  "Syntax table for SLDB mode.")
+
+(define-derived-mode sldb-mode fundamental-mode "sldb"
+  "Superior lisp debugger mode. In addition to ordinary SLIME commands,
+the following are available:\\<sldb-mode-map>
+
+Commands to examine the selected frame:
+   \\[sldb-toggle-details]   - toggle details (local bindings, CATCH tags)
+   \\[sldb-show-source]   - view source for the frame
+   \\[sldb-eval-in-frame]   - eval in frame
+   \\[sldb-pprint-eval-in-frame]   - eval in frame, pretty-print result
+   \\[sldb-disassemble]   - disassemble
+   \\[sldb-inspect-in-frame]   - inspect
+
+Commands to invoke restarts:
+   \\[sldb-quit]   - quit
+   \\[sldb-abort]   - abort
+   \\[sldb-continue]   - continue
+   \\[sldb-invoke-restart-0]-\\[sldb-invoke-restart-9] - restart shortcuts
+
+Commands to navigate frames:
+   \\[sldb-down]   - down
+   \\[sldb-up]   - up
+   \\[sldb-details-down] - down, with details
+   \\[sldb-details-up] - up, with details
+
+Miscellaneous commands:
+   \\[sldb-restart-frame]   - restart frame
+   \\[sldb-return-from-frame]   - return from frame
+   \\[sldb-step]   - step
+   \\[sldb-break-with-default-debugger]   - switch to default debugger
+   \\[slime-interactive-eval]   - eval
+
+Full list of commands:
+
+\\{sldb-mode-map}"
+  (erase-buffer)
+  (set-syntax-table sldb-mode-syntax-table)
+  (slime-set-truncate-lines)
+  ;; Make original slime-connection "sticky" for SLDB commands in this buffer
+  (setq slime-buffer-connection (slime-connection))
+  (add-local-hook 'kill-buffer-hook 'sldb-delete-overlays))
+
+(slime-define-keys sldb-mode-map
+  ("h"    'describe-mode)
+  ("v"    'sldb-show-source)
+  ((kbd "RET") 'sldb-default-action)
+  ("\C-m"      'sldb-default-action)
+  ([mouse-2]  'sldb-default-action/mouse)
+  ([follow-link] 'mouse-face)
+  ("e"    'sldb-eval-in-frame)
+  ("d"    'sldb-pprint-eval-in-frame)
+  ("D"    'sldb-disassemble)
+  ("i"    'sldb-inspect-in-frame)
+  ("n"    'sldb-down)
+  ("p"    'sldb-up)
+  ("\M-n" 'sldb-details-down)
+  ("\M-p" 'sldb-details-up)
+  ("<"    'sldb-beginning-of-backtrace)
+  (">"    'sldb-end-of-backtrace)
+  ("t"    'sldb-toggle-details)
+  ("r"    'sldb-restart-frame)
+  ("R"    'sldb-return-from-frame)
+  ("c"    'sldb-continue)
+  ("s"    'sldb-step)
+  ("x"    'sldb-next)
+  ("o"    'sldb-out)
+  ("b"    'sldb-break-on-return)
+  ("a"    'sldb-abort)
+  ("q"    'sldb-quit)
+  ("B"    'sldb-break-with-default-debugger)
+  ("P"    'sldb-print-condition)
+  ("C"    'sldb-inspect-condition)
+  (":"    'slime-interactive-eval)
+  ("\C-c\C-d" slime-doc-map))
+
+;; Inherit bindings from slime-mode
+(dolist (spec slime-keys)
+  (destructuring-bind (key command &key sldb prefixed &allow-other-keys) spec
+    (when sldb
+      (let ((key (if prefixed (concat slime-prefix-key key) key)))
+        (define-key sldb-mode-map key command)))))
+
+;; Keys 0-9 are shortcuts to invoke particular restarts.
+(defmacro define-sldb-invoke-restart-key (number key)
+  (let ((fname (intern (format "sldb-invoke-restart-%S" number)))
+        (docstring (format "Invoke restart numbered %S." number)))
+    `(progn
+       (defun ,fname ()
+         ,docstring
+	 (interactive)
+	 (sldb-invoke-restart ,number))
+       (define-key sldb-mode-map ,key ',fname))))
+
+(defmacro define-sldb-invoke-restart-keys (from to)
+  `(progn
+     ,@(loop for n from from to to
+	     collect `(define-sldb-invoke-restart-key ,n
+			,(number-to-string n)))))
+
+(define-sldb-invoke-restart-keys 0 9)
+
+
+;;;;; SLDB buffer creation & update
+
+(defun sldb-buffers ()
+  "Return a list of all sldb buffers."
+  (slime-filter-buffers (lambda () (eq major-mode 'sldb-mode))))
+
+(defun sldb-find-buffer (thread &optional connection)
+  (let ((connection (or connection (slime-connection))))
+    (find-if (lambda (buffer)
+               (with-current-buffer buffer
+                 (and (eq slime-buffer-connection connection)
+                      (eq slime-current-thread thread))))
+             (sldb-buffers))))
+
+(defun sldb-get-default-buffer ()
+  "Get a sldb buffer.
+The buffer is chosen more or less randomly."
+  (car (sldb-buffers)))
+
+(defun sldb-get-buffer (thread &optional connection)
+  "Find or create a sldb-buffer for THREAD."
+  (let ((connection (or connection (slime-connection))))
+    (or (sldb-find-buffer thread connection)
+        (let ((name (format "*sldb %s/%s*" (slime-connection-name) thread)))
+          (with-current-buffer (generate-new-buffer name)
+            (setq slime-buffer-connection connection
+                  slime-current-thread thread)
+            (current-buffer))))))
+
+(defun sldb-debugged-continuations (connection)
+  "Return the debugged continuations for CONNECTION."
+  (lexical-let ((accu '()))
+    (dolist (b (sldb-buffers))
+      (with-current-buffer b
+        (when (eq slime-buffer-connection connection)
+          (setq accu (append sldb-continuations accu)))))
+    accu))
+
+(defun sldb-setup (thread level condition restarts frames conts)
+  "Setup a new SLDB buffer.
+CONDITION is a string describing the condition to debug.
+RESTARTS is a list of strings (NAME DESCRIPTION) for each available restart.
+FRAMES is a list (NUMBER DESCRIPTION) describing the initial
+portion of the backtrace. Frames are numbered from 0.
+CONTS is a list of pending Emacs continuations."
+  (with-current-buffer (sldb-get-buffer thread)
+    (unless (equal sldb-level level)
+      (setq buffer-read-only nil)
+      (sldb-mode)
+      (unless sldb-saved-window-configuration
+        (setq sldb-saved-window-configuration (current-window-configuration)))
+      (setq slime-current-thread thread)
+      (setq sldb-level level)
+      (setq mode-name (format "sldb[%d]" sldb-level))
+      (setq sldb-condition condition)
+      (setq sldb-restarts restarts)
+      (setq sldb-continuations conts)
+      (sldb-insert-condition condition)
+      (insert "\n\n" (in-sldb-face section "Restarts:") "\n")
+      (sldb-insert-restarts restarts)
+      (insert "\n" (in-sldb-face section "Backtrace:") "\n")
+      (setq sldb-backtrace-start-marker (point-marker))
+      (save-excursion
+        (sldb-insert-frames (sldb-prune-initial-frames frames) t))
+      (run-hooks 'sldb-hook)
+      (pop-to-buffer (current-buffer))
+      (sldb-recenter-region (point-min) (point))
+      (setq buffer-read-only t)
+      (when (and slime-stack-eval-tags
+                 ;; (y-or-n-p "Enter recursive edit? ")
+                 )
+        (message "Entering recursive edit..")
+        (recursive-edit)))))
+
+(defun sldb-activate (thread level)
+  "Display the debugger buffer for THREAD.
+If LEVEL isn't the same as in the buffer, reinitialize the buffer."
+  (unless (let ((b (sldb-find-buffer thread)))
+            (and b (with-current-buffer b (equal sldb-level level))))
+    (slime-rex (thread level)
+        ('(swank:debugger-info-for-emacs 0 10)
+         nil thread)
+      ((:ok result)
+       (apply #'sldb-setup thread level result)))))
+
+(defun sldb-exit (thread level &optional stepping)
+  "Exit from the debug level LEVEL."
+  (when-let (sldb (sldb-find-buffer thread))
+    (with-current-buffer sldb
+      (unless stepping
+        (set-window-configuration sldb-saved-window-configuration))
+      (let ((inhibit-read-only t))
+        (erase-buffer))
+      (setq sldb-level nil))
+    (when (and (= level 1) (not stepping))
+      (kill-buffer sldb))))
+
+(defun sldb-insert-condition (condition)
+  "Insert the text for CONDITION.
+CONDITION should be a list (MESSAGE TYPE EXTRAS).
+EXTRAS is currently used for the stepper."
+  (destructuring-bind (message type extras) condition
+    (when (> (length message) 70)
+      (add-text-properties 0 (length message) (list 'help-echo message)
+                           message))
+    (slime-insert-propertized '(sldb-default-action sldb-inspect-condition)
+                              (in-sldb-face topline message)
+                              "\n"
+                              (in-sldb-face condition type))
+    (sldb-dispatch-extras extras)))
+
+(defvar sldb-extras-hooks)
+
+(defun sldb-dispatch-extras (extras)
+  ;; this is (mis-)used for the stepper
+  (dolist (extra extras)
+    (destructure-case extra
+      ((:show-frame-source n)
+       (sldb-show-frame-source n))
+      (t
+       (or (run-hook-with-args-until-success 'sldb-extras-hooks extra)
+           ;;(error "Unhandled extra element:" extra)
+           )))))
+
+(defun sldb-insert-restarts (restarts)
+  "Insert RESTARTS and add the needed text props
+RESTARTS should be alist ((NAME DESCRIPTION) ...)."
+  (loop for (name string) in restarts
+        for number from 0 do
+        (insert " ")
+        (slime-insert-propertized
+         `(, at nil restart-number ,number
+                 sldb-default-action sldb-invoke-restart
+                 mouse-face highlight)
+         (in-sldb-face restart-number (number-to-string number))
+         ": ["  (in-sldb-face restart-type name) "] "
+         (in-sldb-face restart string))
+        (insert "\n")))
+
+(defun sldb-prune-initial-frames (frames)
+  "Return the prefix of FRAMES to initially present to the user.
+Regexp heuristics are used to avoid showing SWANK-internal frames."
+  (let* ((case-fold-search t)
+         (rx "^\\([() ]\\|lambda\\)*swank\\>"))
+    (or (loop for frame in frames
+              for (_ string) = frame
+              until (string-match rx string)
+              collect frame)
+        frames)))
+
+(defun sldb-insert-frames (frames more)
+  "Insert FRAMES into buffer.
+If MORE is non-nil, more frames are on the Lisp stack."
+  (mapc #'sldb-insert-frame frames)
+  (when more
+    (destructuring-bind ((num _)) (last frames)
+      (slime-insert-propertized
+       `(, at nil sldb-default-action sldb-fetch-more-frames
+               sldb-previous-frame-number ,num
+               point-entered sldb-fetch-more-frames
+               start-open t
+               face sldb-section-face
+               mouse-face highlight)
+       " --more--")
+      (insert "\n"))))
+
+(defun sldb-insert-frame (frame &optional face)
+  "Insert FRAME with FACE at point.
+If FACE is nil use `sldb-frame-line-face'."
+  (destructuring-bind (number string) frame
+    (let ((props `(frame ,frame sldb-default-action sldb-toggle-details)))
+      (slime-propertize-region props
+        (slime-propertize-region '(mouse-face highlight)
+          (insert " " (in-sldb-face frame-label (format "%2d:" number)) " ")
+          (slime-insert-indented
+           (slime-add-face (or face 'sldb-frame-line-face)
+                           string)))
+        (insert "\n")))))
+
+(defun sldb-fetch-more-frames (&rest ignore)
+  "Fetch more backtrace frames.
+Called on the `point-entered' text-property hook."
+  (let ((inhibit-point-motion-hooks t)
+        (inhibit-read-only t)
+        (prev (get-text-property (point) 'sldb-previous-frame-number)))
+    ;; for unkown reasons, PREV is sometimes nil
+    (when prev
+      (let* ((count 40)
+             (from (1+ prev))
+             (to (+ from count))
+             (frames (slime-eval `(swank:backtrace ,from ,to)))
+             (more (slime-length= frames count))
+             (pos (point)))
+        (delete-region (line-beginning-position) (point-max))
+        (sldb-insert-frames frames more)
+        (goto-char pos)))))
+
+
+;;;;;; SLDB examining text props
+
+(defun sldb-restart-at-point ()
+  (or (get-text-property (point) 'restart-number)
+      (error "No restart at point")))
+
+(defun sldb-frame-number-at-point ()
+  (let ((frame (get-text-property (point) 'frame)))
+    (cond (frame (car frame))
+	  (t (error "No frame at point")))))
+
+(defun sldb-var-number-at-point ()
+  (let ((var (get-text-property (point) 'var)))
+    (cond (var var)
+	  (t (error "No variable at point")))))
+
+(defun sldb-previous-frame-number ()
+  (save-excursion
+    (sldb-backward-frame)
+    (sldb-frame-number-at-point)))
+
+(defun sldb-frame-details-visible-p ()
+  (and (get-text-property (point) 'frame)
+       (get-text-property (point) 'details-visible-p)))
+
+(defun sldb-frame-region ()
+  (save-excursion
+    (goto-char (next-single-property-change (point) 'frame nil (point-max)))
+    (backward-char)
+    (values (previous-single-property-change (point) 'frame)
+	    (next-single-property-change (point) 'frame nil (point-max)))))
+
+(defun sldb-forward-frame ()
+  (goto-char (next-single-char-property-change (point) 'frame)))
+
+(defun sldb-backward-frame ()
+  (goto-char (previous-single-char-property-change
+              (car (sldb-frame-region))
+              'frame
+              nil sldb-backtrace-start-marker)))
+
+(defun sldb-goto-last-frame ()
+  (goto-char (point-max))
+  (while (not (get-text-property (point) 'frame))
+    (goto-char (previous-single-property-change (point) 'frame))))
+
+(defun sldb-beginning-of-backtrace ()
+  "Goto the first frame."
+  (interactive)
+  (goto-char sldb-backtrace-start-marker))
+
+
+;;;;;; SLDB recenter & redisplay
+
+;; FIXME: these functions need factorization
+
+(defvar sldb-show-location-recenter-arg nil
+  "Argument to pass to `recenter' when displaying a source location.")
+
+(defun slime-show-buffer-position (position)
+  "Ensure sure that the POSITION in the current buffer is visible."
+  (save-selected-window
+    (let ((w (select-window (or (get-buffer-window (current-buffer) t)
+                                (display-buffer (current-buffer) t)))))
+      (goto-char position)
+      (push-mark)
+      (unless (pos-visible-in-window-p)
+        (slime-recenter-window w sldb-show-location-recenter-arg)))))
+
+(defun slime-recenter-window (window line)
+  "Set window-start in WINDOW LINE lines before point."
+  (let* ((line (if (not line)
+                   (/ (window-height window) 2)
+                 line))
+         (start (save-excursion
+                  (loop repeat line do (forward-line -1))
+                  (point))))
+    (set-window-start window start)))
+
+(defun sldb-recenter-region (start end &optional center)
+  "Make the region from START to END visible.
+Avoid point motions, if possible.
+Minimize scrolling, if CENTER is nil.
+If CENTER is true, scroll enough to center the region in the window."
+  (let ((pos (point))  (lines (count-screen-lines start end t)))
+    (assert (and (<= start pos) (<= pos end)))
+    ;;(sit-for 0)
+    (cond ((and (pos-visible-in-window-p start)
+                (pos-visible-in-window-p end)))
+          ((< lines (window-height))
+           (cond (center (recenter (+ (/ (- (window-height) 1 lines)
+                                         2)
+                                      (slime-count-lines start pos))))
+                 (t (recenter (+ (- (window-height) 1 lines)
+                                 (slime-count-lines start pos))))))
+          (t
+           (goto-char start)
+           (recenter 0)
+           (cond ((pos-visible-in-window-p pos)
+                  (goto-char pos))
+                 (t
+                  (goto-char start)
+                  (next-line (- (window-height) 2))))))))
+
+;; not sure yet, whether this is a good idea.
+(defmacro slime-save-coordinates (origin &rest body)
+  "Restore line and column relative to ORIGIN, after executing BODY.
+
+This is useful if BODY deletes and inserts some text but we want to
+preserve the current row and column as closely as possible."
+  (let ((base (make-symbol "base"))
+        (goal (make-symbol "goal"))
+        (mark (make-symbol "mark")))
+    `(let* ((,base ,origin)
+            (,goal (slime-coordinates ,base))
+            (,mark (point-marker)))
+       (set-marker-insertion-type ,mark t)
+       (prog1 (save-excursion , at body)
+         (slime-restore-coordinate ,base ,goal ,mark)))))
+
+(put 'slime-save-coordinates 'lisp-indent-function 1)
+
+(defun slime-coordinates (origin)
+  ;; Return a pair (X . Y) for the column and line distance to ORIGIN.
+  (let ((y (slime-count-lines origin (point)))
+        (x (save-excursion
+             (- (current-column)
+                (progn (goto-char origin) (current-column))))))
+    (cons x y)))
+
+(defun slime-restore-coordinate (base goal limit)
+  ;; Move point to GOAL. Coordinates are relative to BASE.
+  ;; Don't move beyond LIMIT.
+  (save-restriction
+    (narrow-to-region base limit)
+    (goto-char (point-min))
+    (let ((col (current-column)))
+      (forward-line (cdr goal))
+      (when (and (eobp) (bolp) (not (bobp)))
+        (backward-char))
+      (move-to-column (+ col (car goal))))))
+
+(defun slime-count-lines (start end)
+  "Return the number of lines between START and END.
+This is 0 if START and END at the same line."
+  (- (count-lines start end)
+     (if (save-excursion (goto-char end) (bolp)) 0 1)))
+
+
+;;;;; SLDB commands
+
+(defun sldb-default-action ()
+  "Invoke the action at point."
+  (interactive)
+  (let ((fn (get-text-property (point) 'sldb-default-action)))
+    (if fn (funcall fn))))
+
+(defun sldb-default-action/mouse (event)
+  "Invoke the action pointed at by the mouse."
+  (interactive "e")
+  (destructuring-bind (mouse-1 (w pos &rest _)) event
+    (save-excursion
+      (goto-char pos)
+      (let ((fn (get-text-property (point) 'sldb-default-action)))
+	(if fn (funcall fn))))))
+
+(defun sldb-end-of-backtrace ()
+  "Fetch the entire backtrace and go to the last frame."
+  (interactive)
+  (sldb-fetch-all-frames)
+  (sldb-goto-last-frame))
+
+(defun sldb-fetch-all-frames ()
+  (let ((inhibit-read-only t)
+        (inhibit-point-motion-hooks t))
+    (sldb-goto-last-frame)
+    (let ((last (sldb-frame-number-at-point)))
+      (goto-char (next-single-char-property-change (point) 'frame))
+      (delete-region (point) (point-max))
+      (save-excursion
+        (sldb-insert-frames (slime-eval `(swank:backtrace ,(1+ last) nil))
+                            nil)))))
+
+
+;;;;;; SLDB show source
+
+(defvar sldb-overlays '()
+  "List of overlays created in source code buffers to highlight expressions.")
+
+(defun sldb-show-source ()
+  "Highlight the frame at point's expression in a source code buffer."
+  (interactive)
+  (sldb-show-frame-source (sldb-frame-number-at-point)))
+
+(defun sldb-show-frame-source (frame-number)
+  (sldb-delete-overlays)
+  (slime-eval-async
+   `(swank:frame-source-location-for-emacs ,frame-number)
+   (lambda (source-location)
+     (destructure-case source-location
+       ((:error message)
+        (message "%s" message)
+        (ding))
+       (t
+        (slime-show-source-location source-location))))))
+
+(defun slime-show-source-location (source-location &optional no-highlight-p)
+  (slime-goto-source-location source-location)
+  (unless no-highlight-p (sldb-highlight-sexp))
+  (slime-show-buffer-position (point)))
+
+(defun sldb-highlight-sexp (&optional start end)
+  "Highlight the first sexp after point."
+  (sldb-delete-overlays)
+  (let ((start (or start (point)))
+	(end (or end (save-excursion (ignore-errors (forward-sexp)) (point)))))
+    (push (make-overlay start (1+ start)) sldb-overlays)
+    (push (make-overlay (1- end) end) sldb-overlays))
+  (dolist (overlay sldb-overlays)
+    (overlay-put overlay 'face 'secondary-selection)))
+
+(defun sldb-delete-overlays ()
+  (mapc #'delete-overlay sldb-overlays)
+  (setq sldb-overlays '()))
+
+
+;;;;;; SLDB toggle details
+
+(defun sldb-toggle-details (&optional on)
+  "Toggle display of details for the current frame.
+The details include local variable bindings and CATCH-tags."
+  (interactive)
+  (assert (sldb-frame-number-at-point))
+  (let ((inhibit-read-only t))
+    (if (or on (not (sldb-frame-details-visible-p)))
+	(sldb-show-frame-details)
+      (sldb-hide-frame-details))))
+
+(defun sldb-show-frame-details ()
+  ;; fetch and display info about local variables and catch tags
+  (destructuring-bind (start end frame locals catches) (sldb-frame-details)
+    (slime-save-coordinates start
+      (delete-region start end)
+      (slime-propertize-region `(frame ,frame details-visible-p t)
+        (sldb-insert-frame frame 'sldb-detailed-frame-line-face)
+        (let ((indent1 "      ")
+              (indent2 "        "))
+          (insert indent1 (in-sldb-face section
+                            (if locals "Locals:" "[No Locals]")) "\n")
+          (sldb-insert-locals locals indent2 frame)
+          (when catches
+            (insert indent1 (in-sldb-face section "Catch-tags:") "\n")
+            (dolist (tag catches)
+              (slime-propertize-region `(catch-tag ,tag)
+                (insert indent2 (in-sldb-face catch-tag (format "%s" tag))
+                        "\n"))))
+          (setq end (point)))))
+    (sldb-recenter-region start end)))
+
+(defun sldb-frame-details ()
+  ;; Return a list (START END FRAME LOCALS CATCHES) for frame at point.
+  (let* ((frame (get-text-property (point) 'frame))
+         (num (car frame))
+         (catches (sldb-catch-tags num))
+         (locals (sldb-frame-locals num)))
+    (destructuring-bind (start end) (sldb-frame-region)
+      (list start end frame locals catches))))
+
+(defun sldb-insert-locals (vars prefix frame)
+  "Insert VARS and add PREFIX at the beginning of each inserted line.
+VAR should be a plist with the keys :name, :id, and :value."
+  (loop for i from 0
+        for var in vars do
+        (destructuring-bind (&key name id value) var
+          (slime-propertize-region (list 'sldb-default-action 'sldb-inspect-var
+                                         'var i)
+            (insert prefix
+                    (in-sldb-face local-name
+                      (concat name (if (zerop id) "" (format "#%d" id))))
+                    " = ")
+            (insert (in-sldb-face local-value value) "\n")))))
+
+(defun sldb-hide-frame-details ()
+  ;; delete locals and catch tags, but keep the function name and args.
+  (destructuring-bind (start end) (sldb-frame-region)
+    (let ((frame (get-text-property (point) 'frame)))
+      (slime-save-coordinates start
+        (delete-region start end)
+        (slime-propertize-region '(details-visible-p nil)
+          (sldb-insert-frame frame))))))
+
+(defun sldb-disassemble ()
+  "Disassemble the code for the current frame."
+  (interactive)
+  (let ((frame (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:sldb-disassemble ,frame)
+                      (lambda (result)
+			(slime-show-description result nil)))))
+
+(defun sldb-print-condition ()
+  "Print the condition SLDB is handling in the REPL.
+This way you can still see what the error was after exiting SLDB."
+  (interactive)
+  (unless sldb-condition
+    (error "No condition known (wrong buffer?)"))
+  (slime-write-string (format "%s\n%s\n"
+                               (first sldb-condition)
+                               (second sldb-condition))))
+
+(defun sldb-frame-locals (frame)
+  (slime-eval `(swank:frame-locals-for-emacs ,frame)))
+
+(defun sldb-catch-tags (frame)
+  (slime-eval `(swank:frame-catch-tags-for-emacs ,frame)))
+
+
+;;;;;; SLDB eval and inspect
+
+(defun sldb-eval-in-frame (string)
+  "Prompt for an expression and evaluate it in the selected frame."
+  (interactive (list (slime-read-from-minibuffer "Eval in frame: ")))
+  (let* ((number (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:eval-string-in-frame ,string ,number)
+                      (if current-prefix-arg
+                          'slime-write-string
+                        'slime-display-eval-result))))
+
+(defun sldb-pprint-eval-in-frame (string)
+  "Prompt for an expression, evaluate in selected frame, pretty-print result."
+  (interactive (list (slime-read-from-minibuffer "Eval in frame: ")))
+  (let* ((number (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:pprint-eval-string-in-frame ,string ,number)
+		      (lambda (result)
+			(slime-show-description result nil)))))
+
+
+
+(defun sldb-inspect-in-frame (string)
+  "Prompt for an expression and inspect it in the selected frame."
+  (interactive (list (slime-read-from-minibuffer 
+                      "Inspect in frame (evaluated): " 
+                      (slime-sexp-at-point))))
+  (let ((number (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:inspect-in-frame ,string ,number)
+                      'slime-open-inspector)))
+
+(defun sldb-inspect-var ()
+  (let ((frame (sldb-frame-number-at-point))
+        (var (sldb-var-number-at-point)))
+    (slime-eval-async `(swank:inspect-frame-var ,frame ,var) 
+                      'slime-open-inspector)))
+
+(defun sldb-inspect-condition ()
+  "Inspect the current debugger condition."
+  (interactive)
+  (slime-eval-async '(swank:inspect-current-condition)
+                    'slime-open-inspector))
+
+
+;;;;;; SLDB movement
+
+(defun sldb-down ()
+  "Select next frame."
+  (interactive)
+  (sldb-forward-frame))
+
+(defun sldb-up ()
+  "Select previous frame."
+  (interactive)
+  (sldb-backward-frame)
+  (when (= (point) sldb-backtrace-start-marker)
+    (recenter (1+ (count-lines (point-min) (point))))))
+
+(defun sldb-sugar-move (move-fn)
+  (let ((inhibit-read-only t))
+    (when (sldb-frame-details-visible-p) (sldb-hide-frame-details))
+    (funcall move-fn)
+    (sldb-show-source)
+    (sldb-toggle-details t)))
+
+(defun sldb-details-up ()
+  "Select previous frame and show details."
+  (interactive)
+  (sldb-sugar-move 'sldb-up))
+
+(defun sldb-details-down ()
+  "Select next frame and show details."
+  (interactive)
+  (sldb-sugar-move 'sldb-down))
+
+
+;;;;;; SLDB restarts
+
+(defun sldb-quit ()
+  "Quit to toplevel."
+  (interactive)
+  (slime-rex () ('(swank:throw-to-toplevel))
+    ((:ok _) (error "sldb-quit returned"))
+    ((:abort))))
+
+(defun sldb-continue ()
+  "Invoke the \"continue\" restart."
+  (interactive)
+  (slime-rex ()
+      ('(swank:sldb-continue))
+    ((:ok _)
+     (message "No restart named continue")
+     (ding))
+    ((:abort))))
+
+(defun sldb-abort ()
+  "Invoke the \"abort\" restart."
+  (interactive)
+  (slime-eval-async '(swank:sldb-abort)
+                    (lambda (v) (message "Restart returned: %S" v))))
+
+(defun sldb-invoke-restart (&optional number)
+  "Invoke a restart.
+Optional NUMBER specifies the restart to invoke, otherwise
+use the restart at point."
+  (interactive)
+  (let ((restart (or number (sldb-restart-at-point))))
+    (slime-rex ()
+        ((list 'swank:invoke-nth-restart-for-emacs sldb-level restart))
+      ((:ok value) (message "Restart returned: %s" value))
+      ((:abort)))))
+
+(defun sldb-break-with-default-debugger ()
+  "Enter default debugger."
+  (interactive)
+  (slime-rex ()
+      ('(swank:sldb-break-with-default-debugger) nil slime-current-thread)
+    ((:abort))))
+
+(defun sldb-step ()
+  "Select the \"continue\" restart and set a new break point."
+  (interactive)
+  (let ((frame (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:sldb-step ,frame))))
+
+(defun sldb-next ()
+  "Select the \"continue\" restart and set a new break point."
+  (interactive)
+  (let ((frame (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:sldb-next ,frame))))
+
+(defun sldb-out ()
+  "Select the \"continue\" restart and set a new break point."
+  (interactive)
+  (let ((frame (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:sldb-out ,frame))))
+
+(defun sldb-break-on-return ()
+  "Set a breakpoint at the current frame.
+The debugger is entered when the frame exits."
+  (interactive)
+  (let ((frame (sldb-frame-number-at-point)))
+    (slime-eval-async `(swank:sldb-break-on-return ,frame)
+                      (lambda (msg) (message "%s" msg)))))
+
+(defun sldb-break (name)
+  "Set a breakpoint at the start of the function NAME."
+  (interactive (list (slime-read-symbol-name "Function: " t)))
+  (slime-eval-async `(swank:sldb-break ,name)
+                    (lambda (msg) (message "%s" msg))))
+
+(defun sldb-return-from-frame (string)
+  "Reads an expression in the minibuffer and causes the function to
+return that value, evaluated in the context of the frame."
+  (interactive (list (slime-read-from-minibuffer "Return from frame: ")))
+  (let* ((number (sldb-frame-number-at-point)))
+    (slime-rex ()
+        ((list 'swank:sldb-return-from-frame number string))
+      ((:ok value) (message "%s" value))
+      ((:abort)))))
+
+(defun sldb-restart-frame ()
+  "Causes the frame to restart execution with the same arguments as it
+was called originally."
+  (interactive)
+  (let* ((number (sldb-frame-number-at-point)))
+    (slime-rex ()
+        ((list 'swank:restart-frame number))
+      ((:ok value) (message "%s" value))
+      ((:abort)))))
+
+
+;;;; Thread control panel
+
+(defun slime-list-threads ()
+  "Display a list of threads."
+  (interactive)
+  (slime-eval-async 
+   '(swank:list-threads)
+   (lambda (threads)
+      (with-current-buffer (get-buffer-create "*slime-threads*")
+       (slime-thread-control-mode)
+       (let ((inhibit-read-only t))
+         (erase-buffer)
+         (loop for idx from 0 
+               for (name status id) in threads
+               do (slime-thread-insert idx name status id))
+         (goto-char (point-min))
+         (setq buffer-read-only t)
+         (pop-to-buffer (current-buffer)))))))
+
+(defun slime-thread-insert (idx name summary id)
+  (slime-propertize-region `(thread-id ,idx)
+    (insert (format "%3s: " id))
+    (slime-insert-propertized '(face bold) name)
+    (insert-char ?\  (- 30 (current-column)))
+    (let ((summary-start (point)))
+      (insert " " summary)
+      (unless (bolp) (insert "\n"))
+      (indent-rigidly summary-start (point) 2))))
+
+
+;;;;; Major mode
+
+(define-derived-mode slime-thread-control-mode fundamental-mode
+  "thread-control"
+  "SLIME Thread Control Panel Mode.
+
+\\{slime-thread-control-mode-map}"
+  (when slime-truncate-lines
+    (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-thread-control-mode-map
+  ("a"         'slime-thread-attach)
+  ("d"         'slime-thread-debug)
+  ("g"         'slime-list-threads)
+  ("k"         'slime-thread-kill)
+  ("q"         'slime-thread-quit))
+
+(defun slime-thread-quit ()
+  (interactive)
+  (slime-eval-async `(swank:quit-thread-browser))
+  (kill-buffer (current-buffer)))
+
+(defun slime-thread-kill ()
+  (interactive)
+  (let ((id (get-text-property (point) 'thread-id)))
+    (slime-eval `(swank:kill-nth-thread ,id)))
+  (call-interactively 'slime-list-threads))
+
+(defun slime-thread-attach ()
+  (interactive)
+  (let ((id (get-text-property (point) 'thread-id))
+        (file (slime-swank-port-file)))
+    (slime-eval-async `(swank:start-swank-server-in-thread ,id ,file)))
+  (slime-read-port-and-connect nil nil))
+
+(defun slime-thread-debug ()
+  (interactive)
+  (let ((id (get-text-property (point) 'thread-id)))
+    (slime-eval-async `(swank:debug-nth-thread ,id))))
+
+
+;;;;; Connection listing
+
+(define-derived-mode slime-connection-list-mode fundamental-mode
+  "connection-list"
+  "SLIME Connection List Mode.
+
+\\{slime-connection-list-mode-map}"
+  (when slime-truncate-lines
+    (set (make-local-variable 'truncate-lines) t)))
+
+(slime-define-keys slime-connection-list-mode-map
+  ((kbd "RET") 'slime-goto-connection)
+  ("d"         'slime-connection-list-make-default)
+  ("g"         'slime-update-connection-list)
+  ((kbd "C-k") 'slime-quit-connection-at-point)
+  ("R"         'slime-restart-connection-at-point))
+
+(defun slime-connection-at-point ()
+  (or (get-text-property (point) 'slime-connection)
+      (error "No connection at point")))
+
+(defun slime-goto-connection ()
+  "Switch to the REPL buffer for the connection at point."
+  (interactive)
+  (let ((slime-dispatching-connection (slime-connection-at-point)))
+    (switch-to-buffer (slime-output-buffer))))
+
+(defun slime-quit-connection-at-point (connection)
+  (interactive (list (slime-connection-at-point)))
+  (let ((slime-dispatching-connection connection))
+    (slime-quit-lisp)
+    (while (memq connection slime-net-processes)
+      (sit-for 0 100)))
+  (slime-update-connection-list))
+
+(defun slime-restart-connection-at-point (connection)
+  (interactive (list (slime-connection-at-point)))
+  (let ((slime-dispatching-connection connection))
+    (slime-restart-inferior-lisp)))
+  
+(defun slime-connection-list-make-default ()
+  "Make the connection at point the default connection."
+  (interactive)
+  (slime-select-connection (slime-connection-at-point))
+  (slime-update-connection-list))
+
+(defun slime-list-connections ()
+  "Display a list of all connections."
+  (interactive)
+  (when (get-buffer "*SLIME connections*")
+    (kill-buffer "*SLIME connections*"))
+  (with-current-buffer
+      (slime-get-temp-buffer-create "*SLIME connections*"
+                                    :mode 'slime-connection-list-mode)
+    (slime-draw-connection-list)
+    (setq buffer-read-only t)
+    (pop-to-buffer (current-buffer))))
+
+(defun slime-update-connection-list ()
+ "Display a list of all connections."
+ (interactive)
+ (let ((pos (point))
+       (inhibit-read-only t))
+   (erase-buffer)
+   (slime-draw-connection-list)
+   (goto-char pos)))
+
+(defun slime-draw-connection-list ()
+  (let ((default-pos nil)
+        (default slime-default-connection)
+        (fstring "%s%2s  %-10s  %-17s  %-7s %-s\n"))
+    (insert (format fstring " " "Nr" "Name" "Port" "Pid" "Type")
+            (format fstring " " "--" "----" "----" "---" "----"))
+    (dolist (p (reverse slime-net-processes))
+      (when (eq default p) (setf default-pos (point)))
+      (slime-insert-propertized 
+       (list 'slime-connection p)
+       (format fstring
+               (if (eq default p) "*" " ")
+               (slime-connection-number p)
+               (slime-connection-name p)
+               (or (process-id p) (process-contact p))
+               (slime-pid p)
+               (slime-lisp-implementation-type p))))
+    (when default 
+      (goto-char default-pos))))
+
+
+;;;; Inspector
+
+(defgroup slime-inspector nil
+  "Inspector faces."
+  :prefix "slime-inspector-"
+  :group 'slime)
+
+(defface slime-inspector-topline-face
+  '((t ()))
+  "Face for top line describing object."
+  :group 'slime-inspector)
+
+(defface slime-inspector-label-face
+  '((t (:inherit font-lock-constant-face)))
+  "Face for labels in the inspector."
+  :group 'slime-inspector)
+
+(defface slime-inspector-value-face
+  (if (slime-face-inheritance-possible-p)
+      '((t (:inherit font-lock-builtin-face)))
+    '((((background light)) (:foreground "MediumBlue" :bold t))
+      (((background dark)) (:foreground "LightGray" :bold t))))
+  "Face for things which can themselves be inspected."
+  :group 'slime-inspector)
+
+(defface slime-inspector-action-face
+  (if (slime-face-inheritance-possible-p)
+      '((t (:inherit font-lock-warning-face)))
+    '((t (:foreground "OrangeRed"))))
+  "Face for labels of inspector actions."
+  :group 'slime-inspector)
+
+(defface slime-inspector-type-face
+    '((t (:inherit font-lock-type-face)))
+  "Face for type description in inspector."
+  :group 'slime-inspector)
+
+(defvar slime-inspector-mark-stack '())
+(defvar slime-saved-window-config)
+
+(defun slime-inspect (string)
+  "Eval an expression and inspect the result."
+  (interactive 
+   (list (slime-read-from-minibuffer "Inspect value (evaluated): "
+				     (slime-sexp-at-point))))
+  (slime-eval-async `(swank:init-inspector ,string) 'slime-open-inspector))
+
+(define-derived-mode slime-inspector-mode fundamental-mode "Slime-Inspector"
+  (set-syntax-table lisp-mode-syntax-table)
+  (slime-set-truncate-lines)
+  (setq buffer-read-only t))
+
+(defun slime-inspector-buffer ()
+  (or (get-buffer "*Slime Inspector*")
+      (with-current-buffer (get-buffer-create "*Slime Inspector*")
+	(setq slime-inspector-mark-stack '())
+        (slime-mode t)
+	(slime-inspector-mode)
+        (make-local-variable 'slime-saved-window-config)
+        (setq slime-saved-window-config (current-window-configuration))
+	(current-buffer))))
+
+(defmacro slime-inspector-fontify (face string)
+  `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string))
+
+(defun slime-open-inspector (inspected-parts &optional point)
+  "Display INSPECTED-PARTS in a new inspector window.
+Optionally set point to POINT."
+  (with-current-buffer (slime-inspector-buffer)
+    (setq slime-buffer-connection (slime-current-connection))
+    (let ((inhibit-read-only t))
+      (erase-buffer)
+      (destructuring-bind (&key title type content) inspected-parts
+        (macrolet ((fontify (face string) 
+                            `(slime-inspector-fontify ,face ,string)))
+          (insert (fontify topline title))
+          (while (eq (char-before) ?\n)
+            (backward-delete-char 1))
+          (insert "\n [" (fontify label "type:") " " (fontify type type) "]\n"
+                  (fontify label "--------------------") "\n")
+          (save-excursion 
+            (mapc #'slime-inspector-insert-ispec content))
+          (pop-to-buffer (current-buffer))
+          (when point
+            (check-type point cons)
+            (ignore-errors 
+              (goto-line (car point))
+              (move-to-column (cdr point)))))))))
+
+(defun slime-inspector-insert-ispec (ispec)
+  (if (stringp ispec)
+      (insert ispec)
+    (destructure-case ispec
+      ((:value string id)
+       (slime-propertize-region 
+           (list 'slime-part-number id 
+                 'mouse-face 'highlight
+                 'face 'slime-inspector-value-face)
+         (insert string)))
+      ((:action string id)
+       (slime-insert-propertized (list 'slime-action-number id
+                                       'mouse-face 'highlight
+                                       'face 'slime-inspector-action-face)
+                                 string)))))
+
+(defun slime-inspector-position ()
+  "Return a pair (Y-POSITION X-POSITION) representing the
+position of point in the current buffer."
+  ;; We make sure we return absolute coordinates even if the user has
+  ;; narrowed the buffer.
+  (save-restriction
+    (widen)
+    (cons (cond ((fboundp 'line-number)
+                 (line-number))         ; XEmacs
+                ((fboundp 'line-number-at-pos)
+                 (line-number-at-pos))  ; Recent GNU Emacs
+                (t (1+ (count-lines 1 (point-at-bol)))))
+          (current-column))))
+
+(defun slime-inspector-operate-on-point ()
+  "If point is on a value then recursivly call the inspector on
+  that value. If point is on an action then call that action."
+  (interactive)
+  (let ((part-number (get-text-property (point) 'slime-part-number))
+        (action-number (get-text-property (point) 'slime-action-number))
+        (opener (lexical-let ((point (slime-inspector-position)))
+                  (lambda (parts)
+                    (when parts
+                      (slime-open-inspector parts point))))))
+    (cond (part-number
+           (slime-eval-async `(swank:inspect-nth-part ,part-number)
+                             opener)
+           (push (slime-inspector-position) slime-inspector-mark-stack))
+          (action-number 
+           (slime-eval-async `(swank::inspector-call-nth-action ,action-number)
+                             opener)))))
+
+(defun slime-inspector-operate-on-click (event)
+  "Inspect the value at the clicked-at position or invoke an action."
+  (interactive "@e")
+  (let ((point (posn-point (event-end event))))
+    (cond ((and point
+                (or (get-text-property point 'slime-part-number)
+                    (get-text-property point 'slime-action-number)))
+           (goto-char point)
+           (slime-inspector-operate-on-point))
+          (t
+           (error "No clickable part here")))))
+
+(defun slime-inspector-copy-down (number)
+  "Evaluate the slot at point via the REPL (to set `*')."
+  (interactive (list (or (get-text-property (point) 'slime-part-number)
+                         (error "No part at point"))))
+  (slime-repl-send-string (format "%s" `(swank:inspector-nth-part ,number)))
+  (slime-repl))
+
+(defun slime-inspector-pop ()
+  (interactive)
+  (slime-eval-async 
+   `(swank:inspector-pop)
+   (lambda (result)
+     (cond (result
+	    (slime-open-inspector result (pop slime-inspector-mark-stack)))
+	   (t 
+	    (message "No previous object")
+	    (ding))))))
+
+(defun slime-inspector-next ()
+  (interactive)
+  (let ((result (slime-eval `(swank:inspector-next))))
+    (cond (result 
+	   (push (slime-inspector-position) slime-inspector-mark-stack)
+	   (slime-open-inspector result))
+	  (t (message "No next object")
+	     (ding)))))
+  
+(defun slime-inspector-quit ()
+  (interactive)
+  (slime-eval-async `(swank:quit-inspector))
+  (set-window-configuration slime-saved-window-config)
+  (kill-buffer (current-buffer)))
+
+(defun slime-find-inspectable-object (direction limit)
+  "Finds the next or previous inspectable object within the
+current buffer, depending on whether DIRECTION is 'NEXT or
+'PREV. LIMIT is the maximum or minimum position in the current
+buffer.
+
+Returns a list of two values: If an object could be found, the
+starting position of the found object and T is returned;
+otherwise LIMIT and NIL is returned.
+"
+  (let ((finder (ecase direction
+                  (next 'next-single-property-change)
+                  (prev 'previous-single-property-change))))
+    (let ((prop nil) (curpos (point)))
+      (while (and (not prop) (not (= curpos limit)))
+        (let ((newpos (funcall finder curpos 'slime-part-number nil limit)))
+          (setq prop (get-text-property newpos 'slime-part-number))
+          (setq curpos newpos)))
+      (list curpos (and prop t)))))
+
+(defun slime-inspector-next-inspectable-object (arg)
+  "Move point to the next inspectable object.
+With optional ARG, move across that many objects.
+If ARG is negative, move backwards."
+  (interactive "p")
+  (let ((maxpos (point-max)) (minpos (point-min))
+        (previously-wrapped-p nil))
+    ;; Forward.
+    (while (> arg 0)
+      (destructuring-bind (pos foundp)
+          (slime-find-inspectable-object 'next maxpos)
+        (if foundp
+            (progn (goto-char pos) (setq arg (1- arg))
+                   (setq previously-wrapped-p nil))
+            (if (not previously-wrapped-p) ; cycle detection
+                (progn (goto-char minpos) (setq previously-wrapped-p t))
+                (error "No inspectable objects")))))
+    ;; Backward.
+    (while (< arg 0)
+      (destructuring-bind (pos foundp)
+          (slime-find-inspectable-object 'prev minpos)
+        ;; SLIME-OPEN-INSPECTOR inserts the title of an inspector page
+        ;; as a presentation at the beginning of the buffer; skip
+        ;; that.  (Notice how this problem can not arise in ``Forward.'')
+        (if (and foundp (/= pos minpos))
+            (progn (goto-char pos) (setq arg (1+ arg))
+                   (setq previously-wrapped-p nil))
+            (if (not previously-wrapped-p) ; cycle detection
+                (progn (goto-char maxpos) (setq previously-wrapped-p t))
+                (error "No inspectable objects")))))))
+
+
+(defun slime-inspector-previous-inspectable-object (arg)
+  "Move point to the previous inspectable object.
+With optional ARG, move across that many objects.
+If ARG is negative, move forwards."
+  (interactive "p")
+  (slime-inspector-next-inspectable-object (- arg)))
+  
+(defun slime-inspector-describe ()
+  (interactive)
+  (slime-eval-describe `(swank:describe-inspectee)))
+
+(defun slime-inspector-pprint (part)
+  (interactive (list (or (get-text-property (point) 'slime-part-number)
+                         (error "No part at point"))))
+  (slime-eval-describe `(swank:pprint-inspector-part ,part)))
+
+(defun slime-inspector-reinspect ()
+  (interactive)
+  (slime-eval-async `(swank:inspector-reinspect)
+                    (lexical-let ((point (slime-inspector-position)))
+                      (lambda (parts)
+                        (slime-open-inspector parts point)))))
+
+(slime-define-keys slime-inspector-mode-map
+  ([return] 'slime-inspector-operate-on-point)
+  ([(meta return)] 'slime-inspector-copy-down)
+  ("\C-m"   'slime-inspector-operate-on-point)
+  ([mouse-2] 'slime-inspector-operate-on-click)
+  ("l" 'slime-inspector-pop)
+  ("n" 'slime-inspector-next)
+  (" " 'slime-inspector-next)
+  ("d" 'slime-inspector-describe)
+  ("p" 'slime-inspector-pprint)
+  ("q" 'slime-inspector-quit)
+  ("g" 'slime-inspector-reinspect)
+  ("\C-i" 'slime-inspector-next-inspectable-object)
+  ([(shift tab)] 'slime-inspector-previous-inspectable-object) ; Emacs translates S-TAB
+  ([backtab]     'slime-inspector-previous-inspectable-object) ; to BACKTAB on X.
+  ("\M-." 'slime-edit-definition))
+
+
+;;;; Buffer selector
+
+(defvar slime-selector-methods nil
+  "List of buffer-selection methods for the `slime-select' command.
+Each element is a list (KEY DESCRIPTION FUNCTION).
+DESCRIPTION is a one-line description of what the key selects.")
+
+(defun slime-selector ()
+  "Select a new buffer by type, indicated by a single character.
+The user is prompted for a single character indicating the method by
+which to choose a new buffer. The `?' character describes the
+available methods.
+
+See `def-slime-selector-method' for defining new methods."
+  (interactive)
+  (message "Select [%s]: " 
+           (apply #'string (mapcar #'car slime-selector-methods)))
+  (let* ((ch (save-window-excursion
+               (select-window (minibuffer-window))
+               (read-char)))
+         (method (find ch slime-selector-methods :key #'car)))
+    (cond ((null method)
+           (message "No method for character: ?\\%c" ch)
+           (ding)
+           (sleep-for 1)
+           (discard-input)
+           (slime-selector))
+          (t
+           (funcall (third method))))))
+
+(defmacro def-slime-selector-method (key description &rest body)
+  "Define a new `slime-select' buffer selection method.
+
+KEY is the key the user will enter to choose this method.
+
+DESCRIPTION is a one-line sentence describing how the method
+selects a buffer.
+
+BODY is a series of forms which are evaluated when the selector
+is chosen. The returned buffer is selected with
+switch-to-buffer."
+  `(setq slime-selector-methods
+         (sort* (cons (list ,key ,description
+                            (lambda () 
+                              (let ((buffer (progn , at body)))
+                                (cond ((get-buffer buffer)
+                                       (switch-to-buffer buffer))
+                                      (t
+                                       (message "No such buffer: %S" buffer)
+                                       (ding))))))
+                      (remove* ,key slime-selector-methods :key #'car))
+                #'< :key #'car)))
+
+(def-slime-selector-method ?? "Selector help buffer."
+  (ignore-errors (kill-buffer "*Select Help*"))
+  (with-current-buffer (get-buffer-create "*Select Help*")
+    (insert "Select Methods:\n\n")
+    (loop for (key line function) in slime-selector-methods
+          do (insert (format "%c:\t%s\n" key line)))
+    (help-mode)
+    (display-buffer (current-buffer) t)
+    (shrink-window-if-larger-than-buffer 
+     (get-buffer-window (current-buffer))))
+  (slime-selector)
+  (current-buffer))
+
+(def-slime-selector-method ?r
+  "SLIME Read-Eval-Print-Loop."
+  (cond ((slime-current-connection)      
+         (slime-output-buffer))
+        ((y-or-n-p "No connection: start Slime? ")
+         (slime))))
+
+(def-slime-selector-method ?i
+  "*inferior-lisp* buffer."
+  (cond ((and (slime-connected-p) (slime-process))
+         (process-buffer (slime-process)))
+        (t
+         "*inferior-lisp*")))
+
+(def-slime-selector-method ?v
+  "*slime-events* buffer."
+  slime-event-buffer-name)
+
+(def-slime-selector-method ?l
+  "most recently visited lisp-mode buffer."
+  (slime-recently-visited-buffer 'lisp-mode))
+
+(def-slime-selector-method ?d
+  "*sldb* buffer for the current connection."
+  (or (sldb-get-default-buffer)
+      (error "No debugger buffer")))
+
+(def-slime-selector-method ?e
+  "most recently visited emacs-lisp-mode buffer."
+  (slime-recently-visited-buffer 'emacs-lisp-mode))
+
+(def-slime-selector-method ?c
+  "SLIME connections buffer."
+  (slime-list-connections)
+  "*SLIME connections*")
+
+(def-slime-selector-method ?t
+  "SLIME threads buffer."
+  (slime-list-threads)
+  (slime-eval `(cl:quote nil))          ;wait until slime-list-threads returns
+  "*slime-threads*")
+
+(defun slime-recently-visited-buffer (mode)
+  "Return the most recently visited buffer whose major-mode is MODE.
+Only considers buffers that are not already visible."
+  (loop for buffer in (buffer-list)
+        when (and (with-current-buffer buffer (eq major-mode mode))
+                  (not (string-match "^ " (buffer-name buffer)))
+                  (null (get-buffer-window buffer 'visible)))
+        return buffer
+        finally (error "Can't find unshown buffer in %S" mode)))
+
+
+;;;; Editing commands
+
+
+
+;;;; Font Lock
+
+(defcustom slime-highlight-suppressed-forms t
+  "Display forms disabled by reader conditionals as comments."
+  :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+  :group 'slime-mode)
+
+(defface slime-reader-conditional-face
+  (if (slime-face-inheritance-possible-p)
+    '((t (:inherit font-lock-comment-face)))
+  '((((background light)) (:foreground "DimGray" :bold t))
+    (((background dark)) (:foreground "LightGray" :bold t))))
+  "Face for compiler notes while selected."
+  :group 'slime-mode-faces)
+
+(defun slime-search-suppressed-forms (limit)
+  "Find reader conditionalized forms where the test is false."
+  (when (and slime-highlight-suppressed-forms
+             (slime-connected-p)
+	     (re-search-forward "^\\([^;\n]*?[ \t(]\\)?#[-+]" limit t))
+    (ignore-errors
+      (let* ((start (- (point) 2))
+             (char (char-before))
+             (e (read (current-buffer)))
+             (val (slime-eval-feature-conditional e)))
+        (when (<= (point) limit)
+          (if (or (and (eq char ?+) (not val))
+                  (and (eq char ?-) val))
+              (progn 
+                (forward-sexp) (backward-sexp)
+                (slime-forward-sexp)
+                (assert (<= (point) limit))
+                (let ((md (match-data)))
+                  (fill md nil)
+                  (setf (first md) start)
+                  (setf (second md) (point))
+                  (set-match-data md)
+                  t))
+            (slime-search-suppressed-forms limit)))))))
+
+(defun slime-activate-font-lock-magic ()
+  (if (featurep 'xemacs)
+      (let ((pattern `((slime-search-suppressed-forms
+                        (0 slime-reader-conditional-face t)))))
+        (dolist (sym '(lisp-font-lock-keywords
+                       lisp-font-lock-keywords-1
+                       lisp-font-lock-keywords-2))
+          (set sym (append (symbol-value sym) pattern))))
+    (font-lock-add-keywords
+     'lisp-mode
+     `((slime-search-suppressed-forms 0 ,''slime-reader-conditional-face t)))))
+
+(when slime-highlight-suppressed-forms
+  (slime-activate-font-lock-magic))
+
+
+;;;; Indentation
+
+(defun slime-update-indentation ()
+  "Update indentation for all macros defined in the Lisp system."
+  (interactive)
+  (slime-eval-async '(swank:update-indentation-information)))
+
+(defvar slime-indentation-update-hooks)
+
+(defun slime-handle-indentation-update (alist)
+  "Update Lisp indent information.
+
+ALIST is a list of (SYMBOL-NAME . INDENT-SPEC) of proposed indentation
+settings for `common-lisp-indent-function'. The appropriate property
+is setup, unless the user already set one explicitly."
+  (dolist (info alist)
+    (let ((symbol (intern (car info)))
+          (indent (cdr info)))
+      ;; Does the symbol have an indentation value that we set?
+      (when (equal (get symbol 'common-lisp-indent-function)
+                   (get symbol 'slime-indent))
+        (put symbol 'slime-indent indent)
+        (put symbol 'common-lisp-indent-function indent))
+      (run-hook-with-args 'slime-indentation-update-hooks symbol indent))))
+
+
+;;;;; Pull-down menu
+
+(defvar slime-easy-menu
+  (let ((C '(slime-connected-p)))
+    `("SLIME"
+      [ "Edit Definition..."       slime-edit-definition ,C ]
+      [ "Return From Definition"   slime-pop-find-definition-stack ,C ]
+      [ "Complete Symbol"          slime-complete-symbol ,C ]
+      [ "Show REPL"                slime-switch-to-output-buffer ,C ]
+      "--"
+      ("Evaluation"
+       [ "Eval Defun"              slime-eval-defun ,C ]
+       [ "Eval Last Expression"    slime-eval-last-expression ,C ]
+       [ "Eval And Pretty-Print"   slime-pprint-eval-last-expression ,C ]
+       [ "Eval Region"             slime-eval-region ,C ]
+       [ "Interactive Eval..."     slime-interactive-eval ,C ]
+       [ "Edit Lisp Value..."      slime-edit-value ,C ]
+       [ "Call Defun"              slime-call-defun ,C ])
+      ("Debugging"
+       [ "Macroexpand Once..."     slime-macroexpand-1 ,C ]
+       [ "Macroexpand All..."      slime-macroexpand-all ,C ]
+       [ "Create Trace Buffer"     slime-redirect-trace-output ,C ]
+       [ "Toggle Trace..."         slime-toggle-trace-fdefinition ,C ]
+       [ "Untrace All"             slime-untrace-all ,C]
+       [ "Disassemble..."          slime-disassemble-symbol ,C ]
+       [ "Inspect..."              slime-inspect ,C ])
+      ("Compilation"
+       [ "Compile Defun"           slime-compile-defun ,C ]
+       [ "Compile/Load File"       slime-compile-and-load-file ,C ]
+       [ "Compile File"            slime-compile-file ,C ]
+       [ "Compile Region"          slime-compile-region ,C ]
+       "--"
+       [ "Next Note"               slime-next-note t ]
+       [ "Previous Note"           slime-previous-note t ]
+       [ "Remove Notes"            slime-remove-notes t ]
+       [ "List Notes"              slime-list-compiler-notes ,C ])
+      ("Cross Reference"
+       [ "Who Calls..."            slime-who-calls ,C ]
+       [ "Who References... "      slime-who-references ,C ]
+       [ "Who Sets..."             slime-who-sets ,C ]
+       [ "Who Binds..."            slime-who-binds ,C ]
+       [ "Who Macroexpands..."     slime-who-macroexpands ,C ]
+       [ "Who Specializes..."      slime-who-specializes ,C ]
+       [ "List Callers..."         slime-list-callers ,C ]
+       [ "List Callees..."         slime-list-callees ,C ]
+       [ "Next Location"           slime-next-location t ])
+      ("Editing"
+       [ "Check Parens"            check-parens t]
+       [ "Update Indentation"      slime-update-indentation ,C]
+       [ "Select Buffer"           slime-selector t])
+      ("Profiling"
+       [ "Toggle Profiling..."     slime-toggle-profile-fdefinition ,C ]
+       [ "Profile Package"         slime-profile-package ,C]
+       [ "Unprofile All"           slime-unprofile-all ,C ]
+       [ "Show Profiled"           slime-profiled-functions ,C ]
+       "--"
+       [ "Report"                  slime-profile-report ,C ]
+       [ "Reset Counters"          slime-profile-reset ,C ])
+      ("Documentation"
+       [ "Describe Symbol..."      slime-describe-symbol ,C ]
+       [ "Apropos..."              slime-apropos ,C ]
+       [ "Apropos all..."          slime-apropos-all ,C ]
+       [ "Apropos Package..."      slime-apropos-package ,C ]
+       [ "Hyperspec..."            slime-hyperspec-lookup t ])
+      "--"
+      [ "Interrupt Command"        slime-interrupt ,C ]
+      [ "Abort Async. Command"     slime-quit ,C ]
+      [ "Sync Package & Directory" slime-sync-package-and-default-directory ,C]
+      [ "Set Package in REPL"      slime-repl-set-package ,C])))
+
+(defvar slime-repl-easy-menu
+  (let ((C '(slime-connected-p)))
+    `("REPL"
+      [ "Send Input"             slime-repl-return ,C ]
+      [ "Close and Send Input "  slime-repl-closing-return ,C ]
+      [ "Interrupt Lisp process" slime-interrupt ,C ]
+      "--"
+      [ "Previous Input"         slime-repl-previous-input t ]
+      [ "Next Input"             slime-repl-next-input t ]
+      [ "Goto Previous Prompt "  slime-repl-previous-prompt t ]
+      [ "Goto Next Prompt "      slime-repl-next-prompt t ]
+      [ "Clear Last Output"      slime-repl-clear-output t ]
+      [ "Clear Buffer "          slime-repl-clear-buffer t ]
+      [ "Kill Current Input"     slime-repl-kill-input t ])))
+      
+(defvar slime-sldb-easy-menu
+  (let ((C '(slime-connected-p)))
+    `("SLDB"
+      [ "Next Frame" sldb-down t ]
+      [ "Previous Frame" sldb-up t ]
+      [ "Toggle Frame Details" sldb-toggle-details t ]
+      [ "Next Frame (Details)" sldb-details-down t ]
+      [ "Previous Frame (Details)" sldb-details-up t ]
+      "--"
+      [ "Eval Expression..." slime-interactive-eval ,C ]
+      [ "Eval in Frame..." sldb-eval-in-frame ,C ]
+      [ "Eval in Frame (pretty print)..." sldb-pprint-eval-in-frame ,C ]
+      [ "Inspect In Frame..." sldb-inspect-in-frame ,C ]
+      [ "Inspect Condition Object" sldb-inspect-condition ,C ]
+      [ "Print Condition to REPL" sldb-print-condition t ]
+      "--"
+      [ "Restart Frame" sldb-restart-frame ,C ]
+      [ "Return from Frame..." sldb-return-from-frame ,C ]
+      ("Invoke Restart"
+       [ "Continue" sldb-continue ,C ]
+       [ "Abort"    sldb-abort ,C ]
+       [ "Step"      sldb-step ,C ]
+       [ "Step next" sldb-next ,C ]
+       [ "Step out"  sldb-out ,C ]
+       )
+      "--"
+      [ "Quit (throw)" sldb-quit ,C ]
+      [ "Break With Default Debugger" sldb-break-with-default-debugger ,C ])))
+
+(easy-menu-define menubar-slime slime-mode-map "SLIME" slime-easy-menu)
+
+(defun slime-add-easy-menu ()
+  (easy-menu-add slime-easy-menu 'slime-mode-map))
+
+(add-hook 'slime-mode-hook 'slime-add-easy-menu)
+
+(defun slime-repl-add-easy-menu ()
+  (easy-menu-define menubar-slime-repl slime-repl-mode-map
+    "REPL" slime-repl-easy-menu)
+  (easy-menu-define menubar-slime slime-repl-mode-map 
+    "SLIME" slime-easy-menu)
+  (easy-menu-add slime-repl-easy-menu 'slime-repl-mode-map))
+
+(add-hook 'slime-repl-mode-hook 'slime-repl-add-easy-menu)
+
+(defun slime-sldb-add-easy-menu ()
+  (easy-menu-define menubar-slime-sldb 
+    sldb-mode-map "SLDB" slime-sldb-easy-menu)
+  (easy-menu-add slime-sldb-easy-menu 'sldb-mode-map))
+
+(add-hook 'sldb-mode-hook 'slime-sldb-add-easy-menu)
+
+
+;;;; Cheat Sheet
+
+(defvar slime-cheat-sheet-table
+  '((:title "Editing lisp code"
+     :map slime-mode-map
+     :bindings ((slime-eval-defun "Evaluate current top level form")
+                (slime-compile-defun "Compile current top level form")
+                (slime-interactive-eval "Prompt for form and eval it")
+                (slime-compile-and-load-file "Compile and load current file")
+                (slime-sync-package-and-default-directory "Synch default package and directory with current buffer")
+                (slime-next-note "Next compiler note")
+                (slime-previous-note "Previous compiler note")
+                (slime-remove-notes "Remove notes")
+                slime-hyperspec-lookup))
+    (:title "Completion"
+     :map slime-mode-map
+     :bindings (slime-indent-and-complete-symbol
+                slime-fuzzy-complete-symbol))
+    (:title "At the REPL" 
+     :map slime-repl-mode-map
+     :bindings (slime-repl-clear-buffer
+                slime-describe-symbol))
+    (:title "Within SLDB buffers" 
+     :map sldb-mode-map
+     :bindings ((sldb-default-action "Do 'whatever' with thing at point")
+                (sldb-toggle-details "Toggle frame details visualization")
+                (sldb-quit "Quit to REPL")
+                (sldb-abort "Invoke ABORT restart")
+                (sldb-continue "Invoke CONTINUE restart (if available)")
+                (sldb-show-source "Jump to frame's source code")
+                (sldb-eval-in-frame "Evaluate in frame at point")
+                (sldb-inspect-in-frame "Evaluate in frame at point and inspect result")))
+    (:title "Within the Inspector" 
+     :map slime-inspector-mode-map
+     :bindings ((slime-inspector-next-inspectable-object "Jump to next inspectable object")
+                (slime-inspector-operate-on-point "Inspect object or execute action at point")
+                (slime-inspector-reinspect "Reinspect current object")
+                (slime-inspector-pop "Return to previous object")
+                (slime-inspector-copy-down "Send object at point to REPL")
+                (slime-inspector-quit "Quit")))
+    (:title "Finding Definitions"
+     :map slime-mode-map
+     :bindings (slime-edit-definition
+                slime-pop-find-definition-stack))))
+
+(defun slime-cheat-sheet ()
+  (interactive)
+  (switch-to-buffer-other-frame (get-buffer-create "*SLIME Cheat Sheet*"))
+  (setq buffer-read-only nil)
+  (delete-region (point-min) (point-max))
+  (goto-char (point-min))
+  (insert "SLIME: The Superior Lisp Interaction Mode for Emacs (minor-mode).\n\n")
+  (dolist (mode slime-cheat-sheet-table)
+    (let ((title (getf mode :title))
+          (mode-map (getf mode :map))
+          (mode-keys (getf mode :bindings)))
+      (insert title)
+      (insert ":\n")
+      (insert (make-string (1+ (length title)) ?-))
+      (insert "\n")
+      (let ((keys '())
+            (descriptions '()))
+        (dolist (func mode-keys)
+          ;; func is eithor the function name or a list (NAME DESCRIPTION)
+          (push (if (symbolp func)
+                    (prin1-to-string func)
+                    (second func))
+                descriptions)
+          (let ((all-bindings (where-is-internal (if (symbolp func)
+                                                     func
+                                                     (first func))
+                                                 (symbol-value mode-map)))
+                (key-bindings '()))
+            (dolist (binding all-bindings)
+              (when (and (vectorp binding)
+                         (integerp (aref binding 0)))
+                (push binding key-bindings)))
+            (push (mapconcat 'key-description key-bindings " or ") keys)))
+        (loop
+           with key-length = (apply 'max (mapcar 'length keys))
+           with desc-length = (apply 'max (mapcar 'length descriptions))
+           for key in (nreverse keys)
+           for desc in (nreverse descriptions)
+           do (insert desc)
+           do (insert (make-string (- desc-length (length desc)) ? ))
+           do (insert " => ")
+           do (insert (if (string= "" key)
+                          "<not on any key>"
+                          key))
+           do (insert "\n")
+           finally do (insert "\n")))))
+  (setq buffer-read-only t)
+  (goto-char (point-min)))
+
+
+;;;; Test suite
+
+(defstruct (slime-test (:conc-name slime-test.))
+  name fname args doc inputs fails-for)
+  
+(defvar slime-tests '()
+  "Names of test functions.")
+
+(defvar slime-test-debug-on-error nil
+  "*When non-nil debug errors in test cases.")
+
+(defvar slime-total-tests nil
+  "Total number of tests executed during a test run.")
+
+(defvar slime-failed-tests nil
+  "Total number of failed tests during a test run.")
+
+(defvar slime-expected-failures nil
+  "Total number of expected failures during a test run")
+
+(defvar slime-test-buffer-name "*Tests*"
+  "The name of the buffer used to display test results.")
+
+
+;; dynamically bound during a single test
+(defvar slime-current-test)
+(defvar slime-unexpected-failures)
+
+
+;;;;; Execution engine
+
+(defun slime-run-tests ()
+  "Run the test suite.
+The results are presented in an outline-mode buffer, with the tests
+that succeeded initially folded away."
+  (interactive)
+  (assert (not (slime-busy-p)))
+  (slime-create-test-results-buffer)
+  (unwind-protect
+      (slime-execute-tests)
+    (pop-to-buffer slime-test-buffer-name)
+    (goto-char (point-min))
+    (hide-body)
+    ;; Expose failed tests
+    (dolist (o (overlays-in (point-min) (point-max)))
+      (when (overlay-get o 'slime-failed-test)
+        (goto-char (overlay-start o))
+        (show-subtree)))))
+
+(defun slime-run-one-test (name)
+  "Ask for the name of a test and then execute the test."
+  (interactive (list (slime-read-test-name)))
+  (let ((test (find name slime-tests :key #'slime-test.name)))
+    (assert test)
+    (let ((slime-tests (list test)))
+      (slime-run-tests))))
+
+(defun slime-read-test-name ()
+  (let ((alist (mapcar (lambda (test) 
+                         (list (symbol-name (slime-test.name test))))
+                       slime-tests)))
+    (read (completing-read "Test: " alist nil t))))
+
+(defun slime-test-should-fail-p (test)
+  (member (slime-lisp-implementation-name)
+          (slime-test.fails-for test)))
+
+(defun slime-execute-tests ()
+  "Execute each test case with each input.
+Return the number of failed tests."
+  (save-window-excursion
+    (let ((slime-total-tests 0)
+          (slime-expected-passes 0)
+          (slime-unexpected-failures 0)
+          (slime-expected-failures 0))
+      (dolist (slime-current-test slime-tests)
+        (with-struct (slime-test. name (function fname) inputs) 
+            slime-current-test
+          (slime-test-heading 1 "%s" name)
+          (dolist (input inputs)
+            (incf slime-total-tests)
+            (message "%s: %s" name input)
+            (slime-test-heading 2 "input: %s" input)
+            (if slime-test-debug-on-error
+                (let ((debug-on-error t)
+                      (debug-on-quit t))
+                  (apply function input))
+              (condition-case err
+                  (apply function input)
+                (error
+                 (cond ((slime-test-should-fail-p slime-current-test)
+                        (incf slime-expected-failures)
+                        (slime-test-failure "ERROR (expected)"
+                                            (format "%S" err)))
+                       (t
+                        (incf slime-unexpected-failures)
+                        (slime-print-check-error err)))))))))
+      (let ((summary (cond ((and (zerop slime-expected-failures)
+                                 (zerop slime-unexpected-failures))
+                            (format "All %S tests completed successfully."
+                                    slime-total-tests))
+                           (t
+                            (format "Failed on %S (%S expected) of %S tests."
+                                    (+ slime-expected-failures
+                                       slime-unexpected-failures)
+                                    slime-expected-failures
+                                    slime-total-tests)))))
+        (save-excursion
+          (with-current-buffer slime-test-buffer-name
+            (goto-char (point-min))
+            (insert summary "\n\n")))
+        (message "%s" summary)
+        slime-unexpected-failures))))
+
+(defun slime-batch-test (results-file)
+  "Run the test suite in batch-mode.
+Exits Emacs when finished. The exit code is the number of failed tests."
+  (let ((slime-test-debug-on-error nil))
+    (slime)
+    ;; Block until we are up and running.
+    (while (not (slime-connected-p))
+      (sit-for 1))
+    (slime-sync-to-top-level 5)
+    (switch-to-buffer "*scratch*")
+    (let ((failed-tests (slime-run-tests)))
+      (with-current-buffer slime-test-buffer-name
+        (slime-delete-hidden-outline-text)
+        (goto-char (point-min))
+        (insert "-*- outline -*-\n\n")
+        (write-file results-file))
+      (kill-emacs failed-tests))))
+
+
+;;;;; Results buffer creation and output
+
+(defun slime-create-test-results-buffer ()
+  "Create and initialize the buffer for test suite results."
+  (ignore-errors (kill-buffer slime-test-buffer-name))
+  (with-current-buffer (get-buffer-create slime-test-buffer-name)
+    (erase-buffer)
+    (outline-mode)
+    (set (make-local-variable 'outline-regexp) "\\*+")
+    (slime-set-truncate-lines)))
+
+(defun slime-delete-hidden-outline-text ()
+  "Delete the hidden parts of an outline-mode buffer."
+  (loop do (when (eq (get-char-property (point) 'invisible) 'outline)
+             (delete-region (point)
+                            (next-single-char-property-change (point)
+                                                              'invisible)))
+        until (eobp)
+        do (goto-char (next-single-char-property-change (point) 'invisible))))
+
+(defun slime-test-heading (level format &rest args)
+  "Output a test suite heading.
+LEVEL gives the depth of nesting: 1 for top-level, 2 for a subheading, etc."
+  (with-current-buffer slime-test-buffer-name
+    (goto-char (point-max))
+    (insert (make-string level ?*)
+            " "
+            (apply 'format format args)
+            "\n")))
+
+(defun slime-test-failure (keyword string)
+  "Output a failure message from the test suite.
+KEYWORD names the type of failure and STRING describes the reason."
+  (with-current-buffer slime-test-buffer-name
+    (goto-char (point-max))
+    (let ((start (point)))
+      (insert keyword ": ")
+      (let ((overlay (make-overlay start (point))))
+        (overlay-put overlay 'slime-failed-test t)
+        (overlay-put overlay 'face 'bold)))
+    (insert string "\n")))
+
+(defun slime-test-message (string)
+  "Output a message from the test suite."
+  (with-current-buffer slime-test-buffer-name
+    (goto-char (point-max))
+    (insert string "\n")))
+
+
+;;;;; Macros for defining test cases
+
+(defmacro def-slime-test (name args doc inputs &rest body)
+  "Define a test case.
+NAME ::= SYMBOL | (SYMBOL (FAILS-FOR*)) is a symbol naming the test.
+ARGS is a lambda-list.
+DOC is a docstring.
+INPUTS is a list of argument lists, each tested separately.
+BODY is the test case. The body can use `slime-check' to test
+conditions (assertions)."
+  (multiple-value-bind (name fails-for) (etypecase name
+                                          (symbol (values name '()))
+                                          (cons name))
+    (let ((fname (intern (format "slime-test-%s" name))))
+      `(progn
+         (defun ,fname ,args
+           ,doc
+           (slime-sync)
+           , at body)
+         (setq slime-tests 
+               (append (remove* ',name slime-tests :key 'slime-test.name)
+                       (list (make-slime-test :name ',name :fname ',fname
+                                              :fails-for ',fails-for
+                                              :inputs ,inputs))))))))
+
+(defmacro slime-check (test-name &rest body)
+  "Check a condition (assertion.)
+TEST-NAME can be a symbol, a string, or a (FORMAT-STRING . ARGS) list.
+BODY returns true if the check succeeds."
+  (let ((check-name (gensym "check-name-")))
+    `(let ((,check-name ,(typecase test-name
+                           (symbol (symbol-name test-name))
+                           (string test-name)
+                           (cons `(format , at test-name)))))
+       (if (progn , at body)
+           (slime-print-check-ok ,check-name)
+         (cond ((slime-test-should-fail-p slime-current-test)
+                (incf slime-expected-failures)
+                (slime-test-failure "FAIL (expected)" ,check-name))
+               (t
+                (incf slime-unexpected-failures)
+                (slime-print-check-failed ,check-name)))
+         (when slime-test-debug-on-error
+           (debug (format "Check failed: %S" ,check-name)))))))
+
+(defun slime-print-check-ok (test-name)
+  (slime-test-message test-name))
+
+(defun slime-print-check-failed (test-name)
+  (slime-test-failure "FAILED" test-name))
+
+(defun slime-print-check-error (reason)
+  (slime-test-failure "ERROR" (format "%S" reason)))
+
+(put 'def-slime-test 'lisp-indent-function 4)
+(put 'slime-check 'lisp-indent-function 1)
+
+
+;;;;; Test case definitions
+
+;; Clear out old tests.
+(setq slime-tests nil)
+
+(defun slime-check-top-level (&optional test-name)
+  (slime-accept-process-output nil 0.001)
+  (slime-check "At the top level (no debugging or pending RPCs)"
+    (slime-at-top-level-p)))
+
+(defun slime-at-top-level-p ()
+  (and (not (sldb-get-default-buffer))
+       (null (slime-rex-continuations))))
+
+(defun slime-wait-condition (name predicate timeout)
+  (let ((end (time-add (current-time) (seconds-to-time timeout))))
+    (while (not (funcall predicate))
+      (cond ((time-less-p end (current-time))
+             (error "Timeout waiting for condition: %S" name))
+            (t
+             ;; XXX if a process-filter enters a recursive-edit, we
+             ;; hang forever
+             (save-excursion
+               (slime-accept-process-output nil 0.1)))))))
+
+(defun slime-sync-to-top-level (timeout)
+  (slime-wait-condition "top-level" #'slime-at-top-level-p timeout))
+
+;; XXX: unused function
+(defun slime-check-sldb-level (expected)
+  (let ((sldb-level (when-let (sldb (sldb-get-default-buffer))
+                      (with-current-buffer sldb
+                        sldb-level))))
+    (slime-check ("SLDB level (%S) is %S" expected sldb-level)
+      (equal expected sldb-level))))
+
+(defun slime-test-expect (name expected actual &optional test)
+  (when (stringp expected) (setq expected (substring-no-properties expected)))
+  (when (stringp actual)   (setq actual (substring-no-properties actual)))
+  (slime-check ("%s:\nexpected: [%S]\n  actual: [%S]" name expected actual)
+    (funcall (or test #'equal) expected actual)))
+
+(defun sldb-level ()
+  (when-let (sldb (sldb-get-default-buffer))
+    (with-current-buffer sldb
+      sldb-level)))
+
+(defun slime-sldb-level= (level)
+  (when-let (sldb (sldb-get-default-buffer))
+    (with-current-buffer sldb
+      (equal sldb-level level))))
+
+(def-slime-test narrowing
+    ()
+    "Check that narrowing is properly sustained."
+    '(())
+  (slime-check-top-level)
+  (let ((random-buffer-name (symbol-name (gensym)))
+        (defun-pos) (tmpbuffer))
+    (with-temp-buffer
+      (dotimes (i 100) (insert (format ";;; %d. line\n" i)))
+      (setq tmpbuffer (current-buffer))
+      (setq defun-pos (point))
+      (insert (concat "(defun __foo__ (x y)" "\n"
+                      "  'nothing)"          "\n"))
+      (dotimes (i 100) (insert (format ";;; %d. line\n" (+ 100 i))))
+      (slime-check "Checking that newly created buffer is not narrowed."
+        (not (slime-buffer-narrowed-p)))
+
+      (goto-char defun-pos)
+      (narrow-to-defun)
+      (slime-check "Checking that narrowing succeeded."
+       (slime-buffer-narrowed-p))
+
+      (slime-with-output-to-temp-buffer (random-buffer-name) nil
+        (slime-check ("Checking that we're in Slime's temp buffer `%s'" random-buffer-name)
+          (equal (buffer-name (current-buffer)) random-buffer-name))
+        (slime-temp-buffer-quit))
+      (kill-buffer random-buffer-name)
+      (slime-check ("Checking that we've got back from `%s'" random-buffer-name)
+        (and (eq (current-buffer) tmpbuffer)
+             (= (point) defun-pos)))
+      
+      (slime-check "Checking that narrowing sustained after quitting Slime's temp buffer."
+        (slime-buffer-narrowed-p))
+
+      (let ((slime-buffer-package "SWANK")
+            (symbol '*buffer-package*))
+        (slime-edit-definition (symbol-name symbol))
+        (slime-check ("Checking that we've got M-. into swank.lisp." symbol)
+          (string= (file-name-nondirectory (buffer-file-name))
+                   "swank.lisp"))
+        (slime-pop-find-definition-stack)
+        (slime-check ("Checking that we've got back.")
+          (and (eq (current-buffer) tmpbuffer)
+               (= (point) defun-pos)))
+
+        (slime-check "Checking that narrowing sustained after M-,"
+        (slime-buffer-narrowed-p)))
+      )) 
+  (slime-check-top-level))
+
+
+(def-slime-test find-definition
+    (name buffer-package snippet)
+    "Find the definition of a function or macro in swank.lisp."
+    '(("read-from-emacs" "SWANK" "(defun read-from-emacs ")
+      ("swank::read-from-emacs" "CL-USER" "(defun read-from-emacs ")
+      ("swank:start-server" "CL-USER" "(defun start-server "))
+  (switch-to-buffer "*scratch*")        ; not buffer of definition
+  (slime-check-top-level)
+  (let ((orig-buffer (current-buffer))
+        (orig-pos (point))
+        (enable-local-variables nil)    ; don't get stuck on -*- eval: -*-
+        (slime-buffer-package buffer-package))
+    (slime-edit-definition name)
+    ;; Postconditions
+    (slime-check ("Definition of `%S' is in swank.lisp." name)
+      (string= (file-name-nondirectory (buffer-file-name)) "swank.lisp"))
+    (slime-check "Definition now at point." (looking-at snippet))
+    (slime-pop-find-definition-stack)
+    (slime-check "Returning from definition restores original buffer/position."
+      (and (eq orig-buffer (current-buffer))
+           (= orig-pos (point)))))
+    (slime-check-top-level))
+
+(def-slime-test complete-symbol
+    (prefix expected-completions)
+    "Find the completions of a symbol-name prefix."
+    '(("cl:compile" (("cl:compile" "cl:compile-file" "cl:compile-file-pathname"
+                      "cl:compiled-function" "cl:compiled-function-p" "cl:compiler-macro"
+                      "cl:compiler-macro-function")
+                     "cl:compile"))
+      ("cl:foobar" (nil ""))
+      ("swank::compile-file" (("swank::compile-file" 
+                               "swank::compile-file-for-emacs"
+                               "swank::compile-file-if-needed"
+                               "swank::compile-file-pathname")
+                              "swank::compile-file"))
+      ("cl:m-v-l" (nil "")))
+  (let ((completions (slime-simple-completions prefix)))
+    (slime-test-expect "Completion set" expected-completions completions)))
+
+(def-slime-test arglist
+    ;; N.B. Allegro apparently doesn't return the default values of
+    ;; optional parameters. Thus the regexp in the start-server
+    ;; expected value. In a perfect world we'd find a way to smooth
+    ;; over this difference between implementations--perhaps by
+    ;; convincing Franz to provide a function that does what we want.
+    (function-name expected-arglist)
+    "Lookup the argument list for FUNCTION-NAME.
+Confirm that EXPECTED-ARGLIST is displayed."
+    '(("swank::operator-arglist" "(swank::operator-arglist name package)")
+      ("swank::create-socket" "(swank::create-socket host port)")
+      ("swank::emacs-connected" "(swank::emacs-connected )")
+      ("swank::compile-string-for-emacs"
+       "(swank::compile-string-for-emacs string buffer position directory)")
+      ("swank::connection.socket-io"
+       "(swank::connection.socket-io \\(struct\\(ure\\)?\\|object\\|instance\\))")
+      ("cl:lisp-implementation-type" "(cl:lisp-implementation-type )")
+      ("cl:class-name" 
+       "(cl:class-name \\(class\\|object\\|instance\\|structure\\))"))
+  (slime-check-top-level)
+  (let ((arglist (slime-eval `(swank:operator-arglist ,function-name 
+                                                      "swank"))))
+    (slime-test-expect "Argument list is as expected"
+                       expected-arglist (downcase arglist)
+                       #'string-match))
+  (slime-check-top-level))
+
+(def-slime-test (compile-defun ("allegro" "lispworks" "clisp"))
+    (program subform)
+    "Compile PROGRAM containing errors.
+Confirm that SUBFORM is correctly located."
+    '(("(defun cl-user::foo () (cl-user::bar))" (cl-user::bar))
+      ("(defun cl-user::foo () 
+          #\\space
+          ;;Sdf              
+          (cl-user::bar))"
+       (cl-user::bar))
+      ("(defun cl-user::foo () 
+             #+(or)skipped
+             #| #||#
+                #||# |#
+             (cl-user::bar))"
+       (cl-user::bar))
+      ("(defun cl-user::foo () 
+           (list `(1 ,(random 10) 2 ,@(random 10) 3 ,(cl-user::bar))))"
+       (cl-user::bar))
+      ("(defun cl-user::foo ()
+          \"\\\" bla bla \\\"\"
+          (cl-user::bar))"
+       (cl-user::bar))
+      ("(defun cl-user::foo ()
+          #.*log-events*
+          (cl-user::bar))"
+       (cl-user::bar))
+      ("#.'(defun x () (/ 1 0))
+        (defun foo () 
+           (cl-user::bar))
+        
+        "
+       (cl-user::bar)))
+  (slime-check-top-level)    
+  (with-temp-buffer 
+    (lisp-mode)
+    (insert program)
+    (setq slime-buffer-package ":swank")
+    (slime-compile-string (buffer-string) 1)
+    (setq slime-buffer-package ":cl-user")
+    (slime-sync-to-top-level 5)
+    (goto-char (point-max))
+    (slime-previous-note)
+    (slime-check error-location-correct
+      (equal (read (current-buffer))
+             subform)))
+  (slime-check-top-level))
+
+(def-slime-test async-eval-debugging (depth)
+  "Test recursive debugging of asynchronous evaluation requests."
+  '((1) (2) (3))
+  (slime-check-top-level)
+  (lexical-let ((depth depth)
+                (debug-hook-max-depth 0))
+    (let ((debug-hook
+           (lambda ()
+             (with-current-buffer (sldb-get-default-buffer)
+               (when (> sldb-level debug-hook-max-depth)
+                 (setq debug-hook-max-depth sldb-level)
+                 (if (= sldb-level depth)
+                     ;; We're at maximum recursion - time to unwind
+                     (sldb-quit)
+                   ;; Going down - enter another recursive debug
+                   ;; Recursively debug.
+                   (slime-eval-async 'no-such-variable)))))))
+      (let ((sldb-hook (cons debug-hook sldb-hook)))
+        (slime-eval-async 'no-such-variable)
+        (slime-sync-to-top-level 5)
+        (slime-check-top-level)
+        (slime-check ("Maximum depth reached (%S) is %S."
+                      debug-hook-max-depth depth)
+          (= debug-hook-max-depth depth))))))
+
+(def-slime-test unwind-to-previous-sldb-level (level2 level1)
+  "Test recursive debugging and returning to lower SLDB levels."
+  '((2 1) (4 2))
+  (slime-check-top-level)
+  (lexical-let ((level2 level2)
+                (level1 level1)
+                (state 'enter)
+                (max-depth 0))
+    (let ((debug-hook
+           (lambda ()
+             (with-current-buffer (sldb-get-default-buffer)
+               (setq max-depth (max sldb-level max-depth))
+               (ecase state
+                 (enter
+                  (cond ((= sldb-level level2)
+                         (setq state 'leave)
+                         (sldb-invoke-restart (sldb-first-abort-restart)))
+                        (t
+                         (slime-eval-async `(cl:aref cl:nil ,sldb-level)))))
+                 (leave
+                  (cond ((= sldb-level level1)
+                         (setq state 'ok)
+                         (sldb-quit))
+                        (t
+                         (sldb-invoke-restart (sldb-first-abort-restart))
+                         ))))))))
+      (let ((sldb-hook (cons debug-hook sldb-hook)))
+        (slime-eval-async `(cl:aref cl:nil 0))
+        (slime-sync-to-top-level 15)
+        (slime-check-top-level)
+        (slime-check ("Maximum depth reached (%S) is %S." max-depth level2)
+          (= max-depth level2))
+        (slime-check ("Final state reached.")
+          (eq state 'ok))))))
+
+(defun sldb-first-abort-restart ()
+  (let ((case-fold-search t))
+    (position-if (lambda (x) (string-match "abort" (car x))) sldb-restarts)))
+
+(def-slime-test loop-interrupt-quit
+    ()
+    "Test interrupting a loop."
+    '(())
+  (slime-check-top-level)
+  (slime-eval-async '(cl:loop) (lambda (_) ) "CL-USER")
+  (slime-accept-process-output nil 1)
+  (slime-check "In eval state." (slime-busy-p))
+  (slime-interrupt)
+  (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)
+  (with-current-buffer (sldb-get-default-buffer) 
+    (sldb-quit))
+  (slime-sync-to-top-level 5)
+  (slime-check-top-level))
+
+(def-slime-test loop-interrupt-continue-interrupt-quit
+    ()
+    "Test interrupting a previously interrupted but continued loop."
+    '(())
+  (slime-check-top-level)
+  (slime-eval-async '(cl:loop) (lambda (_) ) "CL-USER")
+  (sleep-for 1)
+  (slime-wait-condition "running" #'slime-busy-p 5)
+  (slime-interrupt)
+  (slime-wait-condition "First interrupt" (lambda () (slime-sldb-level= 1)) 5)
+  (with-current-buffer (sldb-get-default-buffer)
+    (sldb-continue))
+  (slime-wait-condition "running" (lambda () 
+                                    (and (slime-busy-p)
+                                         (not (sldb-get-default-buffer)))) 5)
+  (slime-interrupt)
+  (slime-wait-condition "Second interrupt" (lambda () (slime-sldb-level= 1)) 5)
+  (with-current-buffer (sldb-get-default-buffer)
+    (sldb-quit))
+  (slime-sync-to-top-level 5)
+  (slime-check-top-level))
+ 
+(def-slime-test interactive-eval 
+    ()
+    "Test interactive eval and continuing from the debugger."
+    '(())
+  (slime-check-top-level)
+  (lexical-let ((done nil))
+    (let ((sldb-hook (lambda () (sldb-continue) (setq done t))))
+      (slime-interactive-eval 
+       "(progn(cerror \"foo\" \"restart\")(cerror \"bar\" \"restart\")(+ 1 2))")
+      (while (not done) (slime-accept-process-output))
+      (slime-sync-to-top-level 5)
+      (slime-check-top-level)
+      (let ((message (current-message)))
+        (slime-check "Minibuffer contains: \"3\""
+          (equal "=> 3 (#x3, #o3, #b11)" message))))))
+
+(def-slime-test interrupt-bubbling-idiot 
+    ()
+    "Test interrupting a loop that sends a lot of output to Emacs."
+    '(())
+  (slime-accept-process-output nil 1)
+  (slime-check-top-level)
+  (slime-eval-async '(cl:loop :for i :from 0 :do (cl:progn (cl:print i) 
+                                                           (cl:finish-output)))
+                    (lambda (_) ) 
+                    "CL-USER")
+  (sleep-for 1)
+  (slime-interrupt)
+  (slime-wait-condition "Debugger visible" 
+                        (lambda () 
+                          (and (slime-sldb-level= 1)
+                               (get-buffer-window (sldb-get-default-buffer))))
+                        30)
+  (with-current-buffer (sldb-get-default-buffer)
+    (sldb-quit))
+  (slime-sync-to-top-level 5))
+
+(def-slime-test package-updating
+    (package-name nicknames)
+    "Test if slime-lisp-package is updated."
+    '(("COMMON-LISP" ("CL"))
+      ("KEYWORD" ("" "KEYWORD"))
+      ("COMMON-LISP-USER" ("CL-USER")))
+  (with-current-buffer (slime-output-buffer)
+    (let ((p (slime-eval 
+              `(swank:listener-eval 
+                ,(format 
+                  "(cl:setq cl:*print-case* :upcase)
+                   (cl:setq cl:*package* (cl:find-package %S))
+                   (cl:package-name cl:*package*)" package-name))
+              (slime-lisp-package))))
+      (slime-check ("slime-lisp-package is %S." package-name)
+        (equal (slime-lisp-package) package-name))
+      (slime-check ("slime-lisp-package-prompt-string is in %S." nicknames)
+        (member (slime-lisp-package-prompt-string) nicknames)))))
+
+(def-slime-test repl-test
+    (input result-contents)
+    "Test simple commands in the minibuffer."
+    '(("(+ 1 2)" "SWANK> (+ 1 2)
+3
+SWANK> ")
+      ("(princ 10)" "SWANK> (princ 10)
+10
+10
+SWANK> ")
+      ("(princ 10)(princ 20)" "SWANK> (princ 10)(princ 20)
+1020
+20
+SWANK> ")
+      ("(dotimes (i 10 77) (princ i) (terpri))" 
+       "SWANK> (dotimes (i 10 77) (princ i) (terpri))
+0
+1
+2
+3
+4
+5
+6
+7
+8
+9
+77
+SWANK> "))
+  (with-current-buffer (slime-output-buffer)
+    (setf (slime-lisp-package-prompt-string) "SWANK"))
+  (kill-buffer (slime-output-buffer))
+  (with-current-buffer (slime-output-buffer)
+    (insert input)
+    (slime-test-expect "Buffer contains input" 
+                       (concat "SWANK> " input)
+                       (buffer-string))
+    (call-interactively 'slime-repl-return)
+    (slime-sync-to-top-level 5)
+    (slime-test-expect "Buffer contains result" 
+                       result-contents (buffer-string))))
+
+(def-slime-test repl-return 
+    (before after result-contents)
+    "Test if slime-repl-return sends the correct protion to Lisp even
+if point is not at the end of the line."
+    '(("(+ 1 2)" "" "SWANK> (+ 1 2)
+3
+SWANK> ")
+("(+ 1 " "2)" "SWANK> (+ 1 2)
+3
+SWANK> ")
+
+("(+ 1\n" "2)" "SWANK> (+ 1
+2)
+3
+SWANK> "))
+  (with-current-buffer (slime-output-buffer)
+    (setf (slime-lisp-package-prompt-string) "SWANK"))
+  (kill-buffer (slime-output-buffer))
+  (with-current-buffer (slime-output-buffer)
+    (insert before)
+    (save-excursion (insert after))
+    (slime-test-expect "Buffer contains input" 
+                       (concat "SWANK> " before after)
+                       (buffer-string))
+    (call-interactively 'slime-repl-return)
+    (slime-sync-to-top-level 5)
+    (slime-test-expect "Buffer contains result" 
+                       result-contents (buffer-string))))
+  
+(def-slime-test repl-read
+    (prompt input result-contents)
+    "Test simple commands in the minibuffer."
+    '(("(read-line)" "foo" "SWANK> (values (read-line))
+foo
+\"foo\"
+SWANK> ")
+      ("(read-char)" "1" "SWANK> (values (read-char))
+1
+#\\1
+SWANK> ")
+      ("(read)" "(+ 2 3
+4)" "SWANK> (values (read))
+\(+ 2 3
+4)
+\(+ 2 3 4)
+SWANK> "))
+  (slime-sync-to-top-level 2)
+  (with-current-buffer (slime-output-buffer)
+    (setf (slime-lisp-package-prompt-string) "SWANK"))
+  (kill-buffer (slime-output-buffer))
+  (with-current-buffer (slime-output-buffer)
+    (insert (format "(values %s)" prompt))
+    (call-interactively 'slime-repl-return)
+    (slime-wait-condition "reading" #'slime-reading-p 5)
+    (insert input)
+    (call-interactively 'slime-repl-return)
+    (slime-sync-to-top-level 5)
+    (slime-test-expect "Buffer contains result" 
+                       result-contents (buffer-string))))
+
+(def-slime-test repl-read-lines
+    (command inputs final-contents)
+    "Test reading multiple lines from the repl."
+    '(("(list (read-line) (read-line) (read-line))" 
+       ("a" "b" "c")
+       "SWANK> (list (read-line) (read-line) (read-line))
+a
+b
+c
+\(\"a\" \"b\" \"c\")
+SWANK> "))
+  (when (slime-output-buffer)
+    (kill-buffer (slime-output-buffer)))
+  (with-current-buffer (slime-output-buffer)
+    (setf (slime-lisp-package-prompt-string) "SWANK")
+    (insert command)
+    (call-interactively 'slime-repl-return)
+    (dolist (input inputs) 
+      (slime-wait-condition "reading" #'slime-reading-p 5)
+      (insert input)
+      (call-interactively 'slime-repl-return))
+    (slime-sync-to-top-level 5)
+    (slime-check "Buffer contains result"
+      (equal final-contents (buffer-string)))))
+
+(def-slime-test repl-type-ahead
+    (command input final-contents)
+    "Ensure that user input is preserved correctly.
+In particular, input inserted while waiting for a result."
+    '(("(sleep 1)" "foo" "SWANK> (sleep 1)
+NIL
+SWANK> foo"))
+  (when (slime-output-buffer)
+    (kill-buffer (slime-output-buffer)))
+  (setf (slime-lisp-package-prompt-string) "SWANK")
+  (with-current-buffer (slime-output-buffer)
+    (insert command)
+    (call-interactively 'slime-repl-return)
+    (insert input)
+    (slime-sync-to-top-level 5)
+    (slime-check "Buffer contains result"
+      (equal final-contents (buffer-string)))))
+
+(def-slime-test interactive-eval-output
+    (input result-contents visiblep)
+    "Test simple commands in the minibuffer."
+    '(("(+ 1 2)" ";;;; (+ 1 2) ...
+SWANK> " nil)
+      ("(princ 10)" ";;;; (princ 10) ...
+10
+SWANK> " t)
+      ("(princ \"ßäëïöüáéíóúàèìòùâêîôûãõøçðåæ\")"
+       ";;;; (princ \"ßäëïöüáéíóúàèìòùâêîôûãõøçðåæ\") ...
+ßäëïöüáéíóúàèìòùâêîôûãõøçðåæ
+SWANK> " t))
+  (when (and (fboundp 'string-to-multibyte)
+             (with-current-buffer (process-buffer (slime-connection))
+               enable-multibyte-characters))
+    (setq input (funcall 'string-to-multibyte input))
+    (setq result-contents (funcall 'string-to-multibyte result-contents)))
+  (with-current-buffer (slime-output-buffer)
+    (setf (slime-lisp-package-prompt-string) "SWANK"))
+  (kill-buffer (slime-output-buffer))
+  (with-current-buffer (slime-output-buffer)
+    (slime-interactive-eval input) 
+    (slime-sync-to-top-level 5)
+    (slime-test-expect "Buffer contains result" 
+                       result-contents (buffer-string))
+    (slime-test-expect "Buffer visible?" 
+                       visiblep
+                       (not (not (get-buffer-window (current-buffer)))))))
+
+(def-slime-test break 
+    ()
+    "Test if BREAK invokes SLDB."
+    '(())
+  (slime-accept-process-output nil 1)
+  (slime-check-top-level)
+  (slime-compile-string (prin1-to-string '(cl:defun cl-user::foo () 
+                                                    (cl:break))) 
+                        0)
+  (slime-sync-to-top-level 2)
+  (slime-eval-async '(cl-user::foo))
+  (slime-wait-condition "Debugger visible" 
+                        (lambda () 
+                          (and (slime-sldb-level= 1)
+                               (get-buffer-window (sldb-get-default-buffer))))
+                        5)
+  (with-current-buffer (sldb-get-default-buffer)
+    (sldb-quit))
+  (slime-accept-process-output nil 1)
+  (slime-sync-to-top-level 5))
+
+(def-slime-test interrupt-at-toplevel
+    ()
+    "Let's see what happens if we send a user interrupt at toplevel."
+    '(())
+  (slime-check-top-level)
+  (slime-interrupt)
+  (slime-wait-condition "Debugger visible" 
+                        (lambda () 
+                          (and (slime-sldb-level= 1)
+                               (get-buffer-window (sldb-get-default-buffer))))
+                        5)
+  (with-current-buffer (sldb-get-default-buffer)
+    (sldb-quit))
+  (slime-sync-to-top-level 5))
+
+(def-slime-test interrupt-in-blocking-read
+    ()
+    "Let's see what happens if we interrupt a blocking read operation."
+    '(())
+  (slime-check-top-level)
+  (when (slime-output-buffer)
+    (setf (slime-lisp-package-prompt-string) "SWANK")
+    (kill-buffer (slime-output-buffer)))
+  (with-current-buffer (slime-output-buffer)
+    (insert "(read-char)")
+    (call-interactively 'slime-repl-return))
+  (slime-wait-condition "reading" #'slime-reading-p 5)
+  (slime-interrupt)
+  (slime-wait-condition "Debugger visible" 
+                        (lambda () 
+                          (and (slime-sldb-level= 1)
+                               (get-buffer-window (sldb-get-default-buffer))))
+                        5)
+  (with-current-buffer (sldb-get-default-buffer)
+    (sldb-continue))
+  (slime-wait-condition "reading" #'slime-reading-p 5)
+  (with-current-buffer (slime-output-buffer)
+    (insert "X")
+    (call-interactively 'slime-repl-return)
+    (slime-sync-to-top-level 5)
+    (slime-test-expect "Buffer contains result" 
+                       "SWANK> (read-char)
+X
+#\\X
+SWANK> " (buffer-string))))
+
+(def-slime-test disconnect
+    ()
+    "Close the connetion.
+Confirm that the subprocess continues gracefully.
+Reconnect afterwards."
+    '(())
+  (slime-check-top-level)
+  (let* ((c (slime-connection))
+         (p (slime-inferior-process c)))
+    (with-current-buffer (process-buffer p)
+      (erase-buffer))
+    (delete-process c)
+    (assert (equal (process-status c) 'closed) nil "Connection not closed")
+    (slime-accept-process-output nil 0.1)
+    (assert (equal (process-status p) 'run) nil "Subprocess not running")
+    (with-current-buffer (process-buffer p)
+      (assert (< (buffer-size) 500) nil "Unusual output"))
+    (slime-inferior-connect p (slime-inferior-lisp-args p))
+    (lexical-let ((hook nil))
+      (setq hook (lambda ()
+                   (remove-hook 'slime-connected-hook hook)))
+      (add-hook 'slime-connected-hook hook)
+      (while (member hook slime-connected-hook)
+        (sit-for 0.5)
+        (slime-accept-process-output nil 0.1)))
+    (slime-test-expect "We are connected again" p (slime-inferior-process))))
+    
+
+;;;; Utilities
+
+;;;;; Misc.
+
+(defun slime-length= (seq n)
+  "Test for whether SEQ contains N number of elements. I.e. it's equivalent
+ to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
+ efficiently implemented."
+  (etypecase seq
+    (list
+     (let ((list seq))
+       (setq list (nthcdr (1- n) list))
+       (and list (null (cdr list)))))
+    (sequence
+     (= (length seq) n))))
+
+(defun slime-length> (seq n)
+  "Return non-nil if (> (length LIST) N)."
+  (etypecase seq
+    (list (nthcdr n seq))
+    (seq  (> (length seq) n))))
+
+(defun slime-split-string (string &optional separators omit-nulls)
+  "This is like `split-string' in Emacs22, but also works in
+Emacs20 and 21."
+  (let ((splits (split-string string separators)))
+    (if omit-nulls
+        (setq splits (remove "" splits))
+      ;; SPLIT-STRING in Emacs before 22.x automatically removed nulls
+      ;; at beginning and end, so we gotta add them here again.
+      (when (or (slime-emacs-20-p) (slime-emacs-21-p))
+        (when (find (elt string 0) separators)
+          (push "" splits))
+        (when (find (elt string (1- (length string))) separators)
+          (setq splits (append splits (list ""))))))
+    splits))
+
+;;;;; Buffer related
+
+(defun slime-buffer-narrowed-p (&optional buffer)
+  "Returns T if BUFFER (or the current buffer respectively) is narrowed."
+  (with-current-buffer (or buffer (current-buffer))
+    (let ((beg (point-min))
+          (end (point-max))
+          (total (buffer-size)))
+      (or (/= beg 1) (/= end (1+ total))))))
+
+
+;;;;; Extracting Lisp forms from the buffer or user
+
+(defun slime-defun-at-point ()
+  "Return the text of the defun at point."
+  (apply #'buffer-substring-no-properties
+         (slime-region-for-defun-at-point)))
+
+(defun slime-region-for-defun-at-point ()
+  "Return the start and end position of the toplevel form at point."
+  (save-excursion
+    (save-match-data
+      (end-of-defun)
+      (let ((end (point)))
+        (beginning-of-sexp)
+        (list (point) end)))))
+
+(defun slime-beginning-of-symbol ()
+  "Move point to the beginning of the current symbol."
+  (when (slime-point-moves-p
+          (while (slime-point-moves-p 
+                   (skip-syntax-backward "w_")
+                   (when (eq (char-before) ?|)
+                     (backward-char)))))
+    (when (eq (char-before) ?#) ; special case for things like "#<foo"
+      (forward-char))))
+
+(defun slime-end-of-symbol ()
+  "Move point to the end of the current symbol."
+  (while (slime-point-moves-p 
+           (skip-syntax-forward "w_")
+           ;; | has the syntax as ", so we need to 
+           ;; treat it manually rather than via syntax. 
+           (when (looking-at "|")
+             (forward-char)))))
+
+(put 'slime-symbol 'end-op 'slime-end-of-symbol)
+(put 'slime-symbol 'beginning-op 'slime-beginning-of-symbol)
+
+(defun slime-symbol-start-pos ()
+  "Return the starting position of the symbol under point.
+The result is unspecified if there isn't a symbol under the point."
+  (save-excursion (slime-beginning-of-symbol) (point)))
+
+(defun slime-symbol-end-pos ()
+  (save-excursion (slime-end-of-symbol) (point)))
+
+(defun slime-symbol-name-at-point ()
+  "Return the name of the symbol at point, otherwise nil."
+  (save-restriction
+    ;; Don't be tricked into grabbing the REPL prompt.
+    (when (and (eq major-mode 'slime-repl-mode)
+               (>= (point) slime-repl-input-start-mark))
+      (narrow-to-region slime-repl-input-start-mark (point-max)))
+    (save-excursion
+      (let ((string (thing-at-point 'slime-symbol)))
+        (and string
+             ;; In Emacs20 (thing-at-point 'symbol) returns "" instead
+             ;; of nil when called from an empty (or
+             ;; narrowed-to-empty) buffer.
+             (not (equal string ""))
+             (substring-no-properties string))))))
+
+(defun slime-symbol-at-point ()
+  "Return the symbol at point, otherwise nil."
+  (let ((name (slime-symbol-name-at-point)))
+    (and name (intern name))))
+
+(defun slime-sexp-at-point ()
+  "Return the sexp at point as a string, otherwise nil."
+  (let ((string (thing-at-point 'sexp)))
+    (if string (substring-no-properties string) nil)))
+
+(defun slime-sexp-at-point-or-error ()
+  "Return the sexp at point as a string, othwise signal an error."
+  (or (slime-sexp-at-point)
+      (error "No expression at point.")))
+
+;;;; Portability library
+
+(when (featurep 'xemacs)
+  (require 'overlay))
+
+(defmacro slime-defun-if-undefined (name &rest rest)
+  ;; We can't decide at compile time whether NAME is properly
+  ;; bound. So we delay the decision to runtime to ensure some
+  ;; definition
+  `(unless (fboundp ',name)
+     (defun ,name , at rest)))
+
+(put 'slime-defun-if-undefined 'lisp-indent-function 2)
+
+(defvar slime-accept-process-output-supports-floats 
+  (ignore-errors (accept-process-output nil 0.0) t))
+
+(defun slime-accept-process-output (&optional process timeout)
+  "Like `accept-process-output' but the TIMEOUT argument can be a float."
+  (cond (slime-accept-process-output-supports-floats
+         (accept-process-output process timeout))
+        (t
+         (accept-process-output process 
+                                (if timeout (truncate timeout))
+                                ;; Emacs 21 uses microsecs; Emacs 22 millisecs
+                                (if timeout (truncate (* timeout 1000000)))))))
+
+(slime-defun-if-undefined next-single-char-property-change
+    (position prop &optional object limit)
+  (let ((limit (typecase limit
+		 (null nil)
+		 (marker (marker-position limit))
+		 (t limit))))
+    (if (stringp object)
+	(or (next-single-property-change position prop object limit)
+	    limit 
+	    (length object))
+      (with-current-buffer (or object (current-buffer))
+	(let ((initial-value (get-char-property position prop object))
+	      (limit (or limit (point-max))))
+	  (loop for pos = position then (next-char-property-change pos limit)
+		if (>= pos limit) return limit
+		if (not (eq initial-value 
+			    (get-char-property pos prop object))) 
+		return pos))))))
+
+(slime-defun-if-undefined previous-single-char-property-change 
+    (position prop &optional object limit)
+  (let ((limit (typecase limit
+		 (null nil)
+		 (marker (marker-position limit))
+		 (t limit))))
+    (if (stringp object)
+	(or (previous-single-property-change position prop object limit)
+	    limit 
+	    (length object))
+      (with-current-buffer (or object (current-buffer))
+	(let ((limit (or limit (point-min))))
+	  (if (<= position limit)
+	      limit
+            (let ((initial-value (get-char-property (1- position)
+                                                    prop object)))
+              (loop for pos = position then 
+                    (previous-char-property-change pos limit)
+                    if (<= pos limit) return limit
+                    if (not (eq initial-value 
+                                (get-char-property (1- pos) prop object))) 
+                    return pos))))))))
+
+(slime-defun-if-undefined next-char-property-change (position &optional limit)
+  (let ((tmp (next-overlay-change position)))
+    (when tmp
+      (setq tmp (min tmp limit)))
+    (next-property-change position nil tmp)))
+
+(slime-defun-if-undefined previous-char-property-change 
+    (position &optional limit)
+  (let ((tmp (previous-overlay-change position)))
+    (when tmp
+      (setq tmp (max tmp limit)))
+    (previous-property-change position nil tmp)))
+        
+(slime-defun-if-undefined substring-no-properties (string &optional start end)
+  (let* ((start (or start 0))
+	 (end (or end (length string)))
+	 (string (substring string start end)))
+    (set-text-properties 0 (- end start) nil string)
+    string))
+
+(slime-defun-if-undefined match-string-no-properties (num &optional string)
+  (if (match-beginning num)
+      (if string
+	  (substring-no-properties string (match-beginning num)
+				   (match-end num))
+	(buffer-substring-no-properties (match-beginning num)
+                                        (match-end num)))))
+
+(slime-defun-if-undefined set-window-text-height (window height)
+  (let ((delta (- height (window-text-height window))))
+    (unless (zerop delta)
+      (let ((window-min-height 1))
+	(if (and window (not (eq window (selected-window))))
+	    (save-selected-window
+	      (select-window window)
+	      (enlarge-window delta))
+	  (enlarge-window delta))))))
+
+(slime-defun-if-undefined window-text-height (&optional window)
+  (1- (window-height window)))
+
+(slime-defun-if-undefined subst-char-in-string (fromchar tochar string 
+						   &optional inplace)
+  "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
+Unless optional argument INPLACE is non-nil, return a new string."
+  (let ((i (length string))
+	(newstr (if inplace string (copy-sequence string))))
+    (while (> i 0)
+      (setq i (1- i))
+      (if (eq (aref newstr i) fromchar)
+	  (aset newstr i tochar)))
+    newstr))
+
+(slime-defun-if-undefined count-screen-lines 
+  (&optional beg end count-final-newline window)
+  (unless beg
+    (setq beg (point-min)))
+  (unless end
+    (setq end (point-max)))
+  (if (= beg end)
+      0
+    (save-excursion
+      (save-restriction
+        (widen)
+        (narrow-to-region (min beg end)
+                          (if (and (not count-final-newline)
+                                   (= ?\n (char-before (max beg end))))
+                              (1- (max beg end))
+                            (max beg end)))
+        (goto-char (point-min))
+        ;; XXX make this xemacs compatible
+        (1+ (vertical-motion (buffer-size) window))))))
+
+(slime-defun-if-undefined seconds-to-time (seconds)
+  "Convert SECONDS (a floating point number) to a time value."
+  (list (floor seconds 65536)
+	(floor (mod seconds 65536))
+	(floor (* (- seconds (ffloor seconds)) 1000000))))
+
+(slime-defun-if-undefined time-less-p (t1 t2)
+  "Say whether time value T1 is less than time value T2."
+  (or (< (car t1) (car t2))
+      (and (= (car t1) (car t2))
+	   (< (nth 1 t1) (nth 1 t2)))))
+
+(slime-defun-if-undefined time-add (t1 t2)
+  "Add two time values.  One should represent a time difference."
+  (let ((high (car t1))
+	(low (if (consp (cdr t1)) (nth 1 t1) (cdr t1)))
+	(micro (if (numberp (car-safe (cdr-safe (cdr t1))))
+		   (nth 2 t1)
+		 0))
+	(high2 (car t2))
+	(low2 (if (consp (cdr t2)) (nth 1 t2) (cdr t2)))
+	(micro2 (if (numberp (car-safe (cdr-safe (cdr t2))))
+		    (nth 2 t2)
+		  0)))
+    ;; Add
+    (setq micro (+ micro micro2))
+    (setq low (+ low low2))
+    (setq high (+ high high2))
+
+    ;; Normalize
+    ;; `/' rounds towards zero while `mod' returns a positive number,
+    ;; so we can't rely on (= a (+ (* 100 (/ a 100)) (mod a 100))).
+    (setq low (+ low (/ micro 1000000) (if (< micro 0) -1 0)))
+    (setq micro (mod micro 1000000))
+    (setq high (+ high (/ low 65536) (if (< low 0) -1 0)))
+    (setq low (logand low 65535))
+
+    (list high low micro)))
+
+(slime-defun-if-undefined line-beginning-position (&optional n)
+  (save-excursion
+    (beginning-of-line n)
+    (point)))
+
+(slime-defun-if-undefined line-end-position (&optional n)
+  (save-excursion
+    (end-of-line n)
+    (point)))
+
+(slime-defun-if-undefined check-parens ()
+    "Verify that parentheses in the current buffer are balanced.
+If they are not, position point at the first syntax error found."
+    (interactive)
+    (let ((saved-point (point))
+	  (state (parse-partial-sexp (point-min) (point-max) -1)))
+      (destructuring-bind (depth innermost-start last-terminated-start
+				 in-string in-comment after-quote 
+				 minimum-depth comment-style 
+				 comment-or-string-start &rest _) state
+	(cond ((and (zerop depth) 
+		    (not in-string) 
+		    (or (not in-comment) 
+			(and (eq comment-style nil) 
+			     (eobp)))
+		    (not after-quote))
+	       (goto-char saved-point)
+	       (message "All parentheses appear to be balanced."))
+	      ((plusp depth)
+	       (goto-char innermost-start)
+	       (error "Missing )"))
+	      ((minusp depth)
+	       (error "Extra )"))
+	      (in-string
+	       (goto-char comment-or-string-start)
+	       (error "String not terminated"))
+	      (in-comment
+	       (goto-char comment-or-string-start)
+	       (error "Comment not terminated"))
+	      (after-quote
+	       (error "After quote"))
+	      (t (error "Shouldn't happen: parsing state: %S" state))))))
+
+(slime-defun-if-undefined read-directory-name (prompt 
+                                               &optional dir default-dirname
+                                               mustmatch initial)
+  (unless dir
+    (setq dir default-directory))
+  (unless default-dirname
+    (setq default-dirname
+	  (if initial (concat dir initial) default-directory)))
+  (let ((file (read-file-name prompt dir default-dirname mustmatch initial)))
+    (setq file (file-name-as-directory (expand-file-name file)))
+    (cond ((file-directory-p file)
+           file)
+          (t 
+           (error "Not a directory: %s" file)))))
+
+(slime-defun-if-undefined check-coding-system (coding-system)
+  (or (eq coding-system 'binary)
+      (error "No such coding system: %S" coding-system)))
+
+(slime-defun-if-undefined process-coding-system (process)
+  '(binary . binary))
+
+(slime-defun-if-undefined set-process-coding-system 
+    (process &optional decoding encoding))
+
+(unless (boundp 'temporary-file-directory)
+  (defvar temporary-file-directory
+    (file-name-as-directory
+     (cond ((memq system-type '(ms-dos windows-nt))
+            (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+           ((memq system-type '(vax-vms axp-vms))
+            (or (getenv "TMPDIR") (getenv "TMP") 
+                (getenv "TEMP") "SYS$SCRATCH:"))
+           (t
+            (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+    "The directory for writing temporary files."))
+
+(unless (fboundp 'with-temp-message)
+  (defmacro with-temp-message (message &rest body)
+    (let ((current-message (make-symbol "current-message"))
+          (temp-message (make-symbol "with-temp-message")))
+      `(let ((,temp-message ,message)
+             (,current-message))
+         (unwind-protect
+             (progn
+               (when ,temp-message
+                 (setq ,current-message (current-message))
+                 (message "%s" ,temp-message))
+               , at body)
+           (and ,temp-message ,current-message
+                (message "%s" ,current-message)))))))
+
+(defun slime-emacs-20-p ()
+  (and (not (featurep 'xemacs))
+       (= emacs-major-version 20)))
+
+(defun slime-emacs-21-p ()
+  (and (not (featurep 'xemacs))
+       (= emacs-major-version 21)))
+
+(when (featurep 'xemacs)
+  (add-hook 'sldb-hook 'sldb-xemacs-emulate-point-entered-hook))
+
+(defun sldb-xemacs-emulate-point-entered-hook ()
+  (add-hook (make-local-variable 'post-command-hook)
+            'sldb-xemacs-post-command-hook))
+
+(defun sldb-xemacs-post-command-hook ()
+  (when (get-text-property (point) 'point-entered)
+    (funcall (get-text-property (point) 'point-entered))))
+
+(slime-defun-if-undefined with-selected-window (window &rest body)
+  `(save-selected-window
+     (select-window ,window)
+     , at body))
+
+;;; Stuff only available in XEmacs
+(slime-defun-if-undefined add-local-hook (hook function &optional append)
+  (make-local-hook hook)
+  (add-hook hook function append t))
+
+(slime-defun-if-undefined remove-local-hook (hook function)
+  (if (local-variable-p hook (current-buffer))
+      (remove-hook hook function t)))
+
+;;;; Some "nice" backward compatiblity bindings for lusers.
+
+(defvar slime-obsolete-commands 
+  '(("\C-c\M-i" (slime repl) slime-fuzzy-complete-symbol)
+    ;; Don't shadow bindings in lisp-mode-map
+    ;;("\M-\C-a" (slime) slime-beginning-of-defun)
+    ;;("\M-\C-e" (slime) slime-end-of-defun)
+    ("\C-c\M-q" (slime) slime-reindent-defun)
+    ("\C-c\C-s" (slime) slime-complete-form)
+    ;; (nil nil slime-close-all-parens-in-sexp)
+    ))
+
+(defun slime-bind-obsolete-commands ()
+  (loop for (key maps command) in slime-obsolete-commands do
+        (dolist (m maps) (slime-bind-obsolete-command m key command))))
+
+(defun slime-bind-obsolete-command (map key command)
+  (let ((map (ecase map
+               (slime slime-mode-map)
+               (repl slime-repl-mode-map))))
+    (unless (lookup-key map key)
+      (define-key map key `(lambda (&rest _)
+                             (interactive)
+                             (slime-upgrade-notice ',command))))))
+
+(slime-bind-obsolete-commands)
+
+(defun slime-upgrade-notice (command)
+  (slime-timebomb (format "The command `%s' has been moved to contrib.
+Please consult the README file in the contrib directory for details.
+
+To fetch the contrib directoy use:  cvs update -d"
+                          command)
+                  15))
+
+;;;;; ... with gratuitous bloat
+
+(defun slime-timebomb (message timeout)
+  (with-current-buffer (generate-new-buffer "*warning*")
+    (insert message "\n\n")
+    (slime-timebomb-progress (point-marker) timeout)
+    (goto-char (point-min))
+    (pop-to-buffer (current-buffer))))
+
+(defun slime-timebomb-progress (mark timeout)
+  (let ((buffer (marker-buffer mark)))
+    (cond ((not (buffer-live-p buffer)))
+	  ((zerop timeout) (kill-buffer buffer))
+	  (t (with-current-buffer buffer
+               (save-excursion
+                 (delete-region mark (point-max))
+                 (goto-char mark)
+                 (slime-timebomb-message timeout))
+	       (run-with-timer 1 nil 
+                               'slime-timebomb-progress mark (1- timeout)))))))
+
+(defun slime-timebomb-message (timeout)
+  (slime-insert-propertized
+   (list 'face (if (zerop (mod timeout 2)) 'highlight 'default))
+   (format "This message will destroy itself in %d seconds." timeout)))
+
+
+;;;; Finishing up
+
+(require 'bytecomp)
+(let ((byte-compile-warnings '()))
+  (mapc #'byte-compile
+        '(slime-alistify
+          slime-log-event
+          slime-events-buffer
+          slime-write-string 
+          slime-output-buffer
+          slime-connection-output-buffer
+          slime-output-filter
+          slime-repl-show-maximum-output
+          slime-process-available-input 
+          slime-dispatch-event 
+          slime-net-filter 
+          slime-net-have-input-p
+          slime-net-decode-length
+          slime-net-read
+          slime-print-apropos
+          slime-show-note-counts
+          slime-insert-propertized
+          slime-tree-insert)))
+
+(provide 'slime)
+(run-hooks 'slime-load-hook)
+
+;; Local Variables: 
+;; outline-regexp: ";;;;+"
+;; indent-tabs-mode: nil
+;; coding: latin-1-unix!
+;; unibyte: t
+;; compile-command: "emacs -batch -L . -eval '(byte-compile-file \"slime.el\")' ; rm -v slime.elc"
+;; End:
+;;; slime.el ends here

Added: branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,541 @@
+;;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;;*"; -*-
+;;;
+;;; swank-abcl.lisp --- Armedbear CL specific code for SLIME. 
+;;;
+;;; Adapted from swank-acl.lisp, Andras Simon, 2004
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed. 
+;;;  
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require :collect) ;just so that it doesn't spoil the flying letters
+  (require :pprint))
+
+(defun sys::break (&optional (format-control "BREAK called") 
+                   &rest format-arguments)
+  (let ((*saved-backtrace* (backtrace-as-list-ignoring-swank-calls)))
+    (with-simple-restart (continue "Return from BREAK.")
+      (invoke-debugger
+       (sys::%make-condition 'simple-condition
+                             (list :format-control format-control
+                                   :format-arguments format-arguments))))
+    nil))
+
+(defimplementation make-fn-streams (input-fn output-fn)
+  (let* ((output (ext:make-slime-output-stream output-fn))
+         (input  (ext:make-slime-input-stream input-fn output)))
+    (values input output)))
+
+(defimplementation call-with-compilation-hooks (function)
+  (funcall function))
+
+;;; swank-mop
+
+;;dummies and definition
+
+(defclass standard-slot-definition ()())
+
+;(defun class-finalized-p (class) t)
+
+(defun slot-definition-documentation (slot) #+nil (documentation slot 't))
+(defun slot-definition-type (slot) t)
+(defun class-prototype (class))
+(defun generic-function-declarations (gf))
+(defun specializer-direct-methods (spec) (mop::class-direct-methods spec))
+
+(defun slot-definition-name (slot)
+  (mop::%slot-definition-name slot))
+
+(defun class-slots (class)
+  (mop::%class-slots class))
+
+(defun method-generic-function (method)
+  (mop::%method-generic-function method))
+
+(defun method-function (method)
+  (mop::%method-function method))
+
+(defun slot-boundp-using-class (class object slotdef)
+  (system::slot-boundp object (slot-definition-name slotdef)))
+
+(defun slot-value-using-class (class object slotdef)
+  (system::slot-value object (slot-definition-name slotdef)))
+
+(import-to-swank-mop
+ '( ;; classes
+   cl:standard-generic-function
+   standard-slot-definition ;;dummy
+   cl:method
+   cl:standard-class
+   ;; standard-class readers
+   mop::class-default-initargs
+   mop::class-direct-default-initargs
+   mop::class-direct-slots
+   mop::class-direct-subclasses
+   mop::class-direct-superclasses
+   mop::eql-specializer
+   mop::class-finalized-p 
+   cl:class-name
+   mop::class-precedence-list
+   class-prototype ;;dummy
+   class-slots
+   specializer-direct-methods 
+   ;; eql-specializer accessors
+   mop::eql-specializer-object
+   ;; generic function readers
+   mop::generic-function-argument-precedence-order
+   generic-function-declarations ;;dummy
+   mop::generic-function-lambda-list
+   mop::generic-function-methods
+   mop::generic-function-method-class
+   mop::generic-function-method-combination
+   mop::generic-function-name
+   ;; method readers
+   method-generic-function
+   method-function
+   mop::method-lambda-list
+   mop::method-specializers
+   mop::method-qualifiers
+   ;; slot readers
+   mop::slot-definition-allocation
+   slot-definition-documentation ;;dummy
+   mop::slot-definition-initargs
+   mop::slot-definition-initform
+   mop::slot-definition-initfunction
+   slot-definition-name
+   slot-definition-type ;;dummy
+   mop::slot-definition-readers
+   mop::slot-definition-writers
+   slot-boundp-using-class
+   slot-value-using-class
+   ))
+
+;;;; TCP Server
+
+
+(defimplementation preferred-communication-style ()
+  :spawn)
+
+
+
+(defimplementation create-socket (host port)
+  (ext:make-server-socket port))
+
+
+(defimplementation local-port (socket)
+  (java:jcall (java:jmethod "java.net.ServerSocket" "getLocalPort") socket))
+
+
+(defimplementation close-socket (socket)
+  (ext:server-socket-close socket))
+
+(defimplementation accept-connection (socket 
+                                      &key external-format buffering timeout)
+  (declare (ignore buffering timeout external-format))
+  (ext:get-socket-stream (ext:socket-accept socket)))
+
+;;;; Unix signals
+
+(defimplementation call-without-interrupts (fn)
+  (funcall fn))
+
+;;there are too many to count
+(defimplementation getpid ()
+  0)
+
+(defimplementation lisp-implementation-type-name ()
+  "armedbear")
+
+(defimplementation set-default-directory (directory)
+  (let ((dir (sys::probe-directory directory)))
+    (when dir (setf *default-pathname-defaults* dir))
+    (namestring dir)))
+
+
+;;;; Misc
+
+(defimplementation arglist (fun)
+  (cond ((symbolp fun)
+         (multiple-value-bind (arglist present) (sys::arglist fun)
+           (if present arglist :not-available)))
+        (t :not-available)))
+
+(defimplementation function-name (function)
+  (nth-value 2 (function-lambda-expression function)))
+
+(defimplementation macroexpand-all (form)
+  (macroexpand form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (flet ((doc (kind &optional (sym symbol))
+             (or (documentation sym kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (when (boundp symbol)
+                   (doc 'variable)))
+      (maybe-push
+       :function (if (fboundp symbol)
+                     (doc 'function)))
+      (maybe-push
+       :class (if (find-class symbol nil)
+                  (doc 'class)))
+      result)))
+
+
+(defimplementation describe-definition (symbol namespace)
+  (ecase namespace
+    (:variable 
+     (describe symbol))
+    ((:function :generic-function)
+     (describe (symbol-function symbol)))
+    (:class
+     (describe (find-class symbol)))))
+
+(defimplementation describe-definition (symbol namespace)
+  (ecase namespace
+    (:variable 
+     (describe symbol))
+    ((:function :generic-function)
+     (describe (symbol-function symbol)))
+    (:class
+     (describe (find-class symbol)))))
+
+
+;;;; Debugger
+
+(defvar *sldb-topframe*)
+
+(defun backtrace-as-list-ignoring-swank-calls ()
+  (let ((list (ext:backtrace-as-list)))
+    (subseq list (1+ (or (position (intern "SWANK-DEBUGGER-HOOK" 'swank) list :key 'car) -1)))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (let ((*sldb-topframe* (car (backtrace-as-list-ignoring-swank-calls)) #+nil (excl::int-newest-frame)))
+    (funcall debugger-loop-fn)))
+
+(defun nth-frame (index)
+  (nth index (backtrace-as-list-ignoring-swank-calls)))
+
+(defimplementation compute-backtrace (start end)
+  (let ((end (or end most-positive-fixnum)))
+    (subseq (backtrace-as-list-ignoring-swank-calls) start end)))
+
+(defimplementation print-frame (frame stream)
+  (write-string (string-trim '(#\space #\newline)
+                             (prin1-to-string frame))
+                stream))
+
+(defimplementation frame-locals (index)
+  `(,(list :name "??" :id 0 :value "??")))
+
+
+(defimplementation frame-catch-tags (index)
+  (declare (ignore index))
+  nil)
+
+#+nil
+(defimplementation disassemble-frame (index)
+  (disassemble (debugger:frame-function (nth-frame index))))
+
+(defimplementation frame-source-location-for-emacs (index)
+  (list :error (format nil "Cannot find source for frame: ~A"
+                       (nth-frame index))))
+
+#+nil
+(defimplementation eval-in-frame (form frame-number)
+  (debugger:eval-form-in-context 
+   form
+   (debugger:environment-of-frame (nth-frame frame-number))))
+
+#+nil
+(defimplementation return-from-frame (frame-number form)
+  (let ((frame (nth-frame frame-number)))
+    (multiple-value-call #'debugger:frame-return 
+      frame (debugger:eval-form-in-context 
+             form 
+             (debugger:environment-of-frame frame)))))
+                         
+;;; XXX doesn't work for frames with arguments 
+#+nil
+(defimplementation restart-frame (frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (debugger:frame-retry frame (debugger:frame-function frame))))
+                          
+;;;; Compiler hooks
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename*)
+
+(in-package :swank-backend)
+
+(defun handle-compiler-warning (condition)
+  (let ((loc nil));(getf (slot-value condition 'excl::plist) :loc)))
+    (unless (member condition *abcl-signaled-conditions*) ; filter condition signaled more than once.
+      (push condition *abcl-signaled-conditions*) 
+      (signal (make-condition
+               'compiler-condition
+               :original-condition condition
+               :severity :warning
+               :message (format nil "~A" condition)
+               :location (cond (*buffer-name*
+                                (make-location 
+                                 (list :buffer *buffer-name*)
+                                 (list :position *buffer-start-position*)))
+                               (loc
+                                (destructuring-bind (file . pos) loc
+                                  (make-location
+                                   (list :file (namestring (truename file)))
+                                   (list :position (1+ pos)))))
+                               (t  
+                                (make-location
+                                 (list :file *compile-filename*)
+                                 (list :position 1)))))))))
+
+(defvar *abcl-signaled-conditions*)
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (declare (ignore external-format))
+  (let ((jvm::*resignal-compiler-warnings* t)
+        (*abcl-signaled-conditions* nil))
+    (handler-bind ((warning #'handle-compiler-warning))
+      (let ((*buffer-name* nil)
+            (*compile-filename* filename))
+        (multiple-value-bind (fn warn fail) (compile-file filename)
+          (when (and load-p (not fail))
+            (load fn)))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (let ((jvm::*resignal-compiler-warnings* t)
+        (*abcl-signaled-conditions* nil))
+    (handler-bind ((warning #'handle-compiler-warning))                 
+      (let ((*buffer-name* buffer)
+            (*buffer-start-position* position)
+            (*buffer-string* string))
+        (funcall (compile nil (read-from-string
+                               (format nil "(~S () ~A)" 'lambda string))))))))
+
+#|
+;;;; Definition Finding
+
+(defun find-fspec-location (fspec type)
+  (let ((file (excl::fspec-pathname fspec type)))
+    (etypecase file
+      (pathname
+       (let ((start (scm:find-definition-in-file fspec type file)))
+         (make-location (list :file (namestring (truename file)))
+                        (if start
+                            (list :position (1+ start))
+                            (list :function-name (string fspec))))))
+      ((member :top-level)
+       (list :error (format nil "Defined at toplevel: ~A" fspec)))
+      (null 
+       (list :error (format nil "Unkown source location for ~A" fspec))))))
+
+(defun fspec-definition-locations (fspec)
+  (let ((defs (excl::find-multiple-definitions fspec)))
+    (loop for (fspec type) in defs 
+          collect (list fspec (find-fspec-location fspec type)))))
+
+(defimplementation find-definitions (symbol)
+  (fspec-definition-locations symbol))
+
+|#
+
+(defun source-location (symbol)
+  (when (pathnamep (ext:source-pathname symbol))
+    `(((,symbol)
+       (:location 
+        (:file ,(namestring (ext:source-pathname symbol)))
+        (:position ,(or (ext:source-file-position symbol) 0) t)
+        (:snippet nil))))))
+
+
+(defimplementation find-definitions (symbol)
+  (source-location symbol))
+
+#| 
+Uncomment this if you have patched xref.lisp, as in 
+http://article.gmane.org/gmane.lisp.slime.devel/2425
+Also, make sure that xref.lisp is loaded by modifying the armedbear
+part of *sysdep-pathnames* in swank.loader.lisp. 
+
+;;;; XREF
+(setq pxref:*handle-package-forms* '(cl:in-package))
+
+(defmacro defxref (name function)
+  `(defimplementation ,name (name)
+    (xref-results (,function name))))
+
+(defxref who-calls      pxref:list-callers)
+(defxref who-references pxref:list-readers)
+(defxref who-binds      pxref:list-setters)
+(defxref who-sets       pxref:list-setters)
+(defxref list-callers   pxref:list-callers)
+(defxref list-callees   pxref:list-callees)
+
+(defun xref-results (symbols)
+  (let ((xrefs '()))
+    (dolist (symbol symbols)
+      (push (list symbol (cadar (source-location symbol))) xrefs))
+    xrefs))
+|#
+
+;;;; Inspecting
+
+(defclass abcl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'abcl-inspector))
+
+(defmethod inspect-for-emacs ((slot mop::slot-definition) 
+                              (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values "A slot." 
+          `("Name: " (:value ,(mop::%slot-definition-name slot))
+            (:newline)
+            "Documentation:" (:newline)
+            ,@(when (slot-definition-documentation slot)
+                `((:value ,(slot-definition-documentation slot)) (:newline)))
+            "Initialization:" (:newline)
+            "  Args: " (:value ,(mop::%slot-definition-initargs slot)) (:newline)
+            "  Form: "  ,(if (mop::%slot-definition-initfunction slot)
+                             `(:value ,(mop::%slot-definition-initform slot))
+                             "#<unspecified>") (:newline)
+            "  Function: " (:value ,(mop::%slot-definition-initfunction slot))
+            (:newline))))
+
+(defmethod inspect-for-emacs ((f function) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values "A function."
+          `(,@(when (function-name f)
+                    `("Name: " 
+                      ,(princ-to-string (function-name f)) (:newline)))
+            ,@(multiple-value-bind (args present) 
+                                   (sys::arglist f)
+                                   (when present `("Argument list: " ,(princ-to-string args) (:newline))))
+            (:newline)
+            #+nil,@(when (documentation f t)
+                         `("Documentation:" (:newline) ,(documentation f t) (:newline)))
+            ,@(when (function-lambda-expression f)
+                    `("Lambda expression:" 
+                      (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline))))))
+
+#|
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (let* ((class (class-of o))
+         (slots (mop::class-slots class)))
+    (values (format nil "~A~%   is a ~A" o class)
+            (mapcar (lambda (slot)
+                      (let ((name (mop::slot-definition-name slot)))
+                        (cons (princ-to-string name)
+                              (slot-value o name))))
+                    slots))))
+|#
+
+;;;; Multithreading
+
+(defimplementation startup-multiprocessing ()
+  #+nil(mp:start-scheduler))
+
+(defimplementation spawn (fn &key name)
+  (ext:make-thread (lambda () (funcall fn)) :name name))
+
+(defvar *thread-props-lock* (ext:make-thread-lock))
+
+(defvar *thread-props* (make-hash-table) ; should be a weak table
+  "A hashtable mapping threads to a plist.")
+
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+  (ext:with-thread-lock (*thread-props-lock*)
+    (or (getf (gethash thread *thread-props*) 'id)
+        (setf (getf (gethash thread *thread-props*) 'id)
+              (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+  (find id (all-threads) 
+        :key (lambda (thread)
+                (getf (gethash thread *thread-props*) 'id))))
+
+(defimplementation thread-name (thread)
+  (ext:thread-name thread))
+
+(defimplementation thread-status (thread)
+  (format nil "Thread is ~:[dead~;alive~]" (ext:thread-alive-p thread)))
+
+(defimplementation make-lock (&key name)
+  (ext:make-thread-lock))
+
+(defimplementation call-with-lock-held (lock function)
+  (ext:with-thread-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+  (ext:current-thread))
+
+(defimplementation all-threads ()
+  (copy-list (ext:mapcar-threads #'identity)))
+
+(defimplementation interrupt-thread (thread fn)
+  (ext:interrupt-thread thread fn))
+
+(defimplementation kill-thread (thread)
+  (ext:destroy-thread thread))
+
+(defun mailbox (thread)
+  "Return THREAD's mailbox."
+  (ext:with-thread-lock (*thread-props-lock*)
+    (or (getf (gethash thread *thread-props*) 'mailbox)
+        (setf (getf (gethash thread *thread-props*) 'mailbox)
+              (ext:make-mailbox)))))
+
+(defimplementation send (thread object)
+  (ext:mailbox-send (mailbox thread) object))
+
+(defimplementation receive ()
+  (ext:mailbox-read (mailbox (ext:current-thread))))
+
+;;; Auto-flush streams
+
+;; XXX race conditions
+(defvar *auto-flush-streams* '())
+  
+(defvar *auto-flush-thread* nil)
+
+(defimplementation make-stream-interactive (stream)
+  (setq *auto-flush-streams* (adjoin stream *auto-flush-streams*))
+  (unless *auto-flush-thread*
+    (setq *auto-flush-thread*
+          (ext:make-thread #'flush-streams 
+                           :name "auto-flush-thread"))))
+
+(defun flush-streams ()
+  (loop
+   (setq *auto-flush-streams* 
+         (remove-if (lambda (x) 
+                      (not (and (open-stream-p x)
+                                (output-stream-p x))))
+                    *auto-flush-streams*))
+   (mapc #'finish-output *auto-flush-streams*)
+   (sleep 0.15)))
+
+(defimplementation quit-lisp ()
+  (ext:exit))
+
+;; WORKAROUND: call/initialize accessors at load time
+(let ((c (make-condition 'compiler-condition 
+                          :original-condition nil
+                          :severity ':note :message "" :location nil))
+       (slots `(severity message short-message references location)))
+   (dolist (slot slots)
+     (funcall slot c)))

Added: branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,774 @@
+;;;;                  -*- indent-tabs-mode: nil; outline-regexp: ";;;;;* "; -*-
+;;;
+;;; swank-allegro.lisp --- Allegro CL specific code for SLIME. 
+;;;
+;;; Created 2003
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;  
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require :sock)
+  (require :process))
+
+(import-from :excl *gray-stream-symbols* :swank-backend)
+
+;;; swank-mop
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+  (documentation slot t))
+
+
+;;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+  :spawn)
+
+(defimplementation create-socket (host port)
+  (socket:make-socket :connect :passive :local-port port 
+                      :local-host host :reuse-address t))
+
+(defimplementation local-port (socket)
+  (socket:local-port socket))
+
+(defimplementation close-socket (socket)
+  (close socket))
+
+(defimplementation accept-connection (socket &key external-format buffering
+                                             timeout)
+  (declare (ignore buffering timeout))
+  (let ((s (socket:accept-connection socket :wait t)))
+    (when external-format
+      (setf (stream-external-format s) external-format))
+    s))
+
+(defvar *external-format-to-coding-system*
+  '((:iso-8859-1 
+     "latin-1" "latin-1-unix" "iso-latin-1-unix" 
+     "iso-8859-1" "iso-8859-1-unix")
+    (:utf-8 "utf-8" "utf-8-unix")
+    (:euc-jp "euc-jp" "euc-jp-unix")
+    (:us-ascii "us-ascii" "us-ascii-unix")
+    (:emacs-mule "emacs-mule" "emacs-mule-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (let ((e (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                      *external-format-to-coding-system*)))
+    (and e (excl:crlf-base-ef 
+            (excl:find-external-format (car e) 
+                                       :try-variant t)))))
+
+(defimplementation format-sldb-condition (c)
+  (princ-to-string c))
+
+(defimplementation call-with-syntax-hooks (fn)
+  (funcall fn))
+
+;;;; Unix signals
+
+(defimplementation call-without-interrupts (fn)
+  (excl:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+  (excl::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  "allegro")
+
+(defimplementation set-default-directory (directory)
+  (let* ((dir (namestring (truename (merge-pathnames directory)))))
+    (setf *default-pathname-defaults* (pathname (excl:chdir dir)))
+    dir))
+
+(defimplementation default-directory ()
+  (namestring (excl:current-directory)))
+
+;;;; Misc
+
+(defimplementation arglist (symbol)
+  (handler-case (excl:arglist symbol)
+    (simple-error () :not-available)))
+
+(defimplementation macroexpand-all (form)
+  (excl::walk form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (flet ((doc (kind &optional (sym symbol))
+             (or (documentation sym kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (when (boundp symbol)
+                   (doc 'variable)))
+      (maybe-push
+       :function (if (fboundp symbol)
+                     (doc 'function)))
+      (maybe-push
+       :class (if (find-class symbol nil)
+                  (doc 'class)))
+      result)))
+
+(defimplementation describe-definition (symbol namespace)
+  (ecase namespace
+    (:variable 
+     (describe symbol))
+    ((:function :generic-function)
+     (describe (symbol-function symbol)))
+    (:class
+     (describe (find-class symbol)))))
+
+(defimplementation make-stream-interactive (stream)
+  (setf (interactive-stream-p stream) t))
+
+;;;; Debugger
+
+(defvar *sldb-topframe*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (let ((*sldb-topframe* (find-topframe))
+        (excl::*break-hook* nil))
+    (funcall debugger-loop-fn)))
+
+(defimplementation sldb-break-at-start (fname)
+  ;; :print-before is kind of mis-used but we just want to stuff our break form
+  ;; somewhere. This does not work for setf, :before and :after methods, which
+  ;; need special syntax in the trace call, see ACL's doc/debugging.htm chapter 10.
+  (eval `(trace (,fname
+                 :print-before
+                 ((break "Function start breakpoint of ~A" ',fname)))))
+  `(:ok ,(format nil "Set breakpoint at start of ~S" fname)))
+
+(defun find-topframe ()
+  (let ((skip-frames 3))
+    (do ((f (excl::int-newest-frame) (next-frame f))
+         (i 0 (1+ i)))
+        ((= i skip-frames) f))))
+
+(defun next-frame (frame)
+  (let ((next (excl::int-next-older-frame frame)))
+    (cond ((not next) nil)
+          ((debugger:frame-visible-p next) next)
+          (t (next-frame next)))))
+
+(defun nth-frame (index)
+  (do ((frame *sldb-topframe* (next-frame frame))
+       (i index (1- i)))
+      ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+  (let ((end (or end most-positive-fixnum)))
+    (loop for f = (nth-frame start) then (next-frame f)
+	  for i from start below end
+	  while f
+	  collect f)))
+
+(defimplementation print-frame (frame stream)
+  (debugger:output-frame stream frame :moderate))
+
+(defimplementation frame-locals (index)
+  (let ((frame (nth-frame index)))
+    (loop for i from 0 below (debugger:frame-number-vars frame)
+	  collect (list :name (debugger:frame-var-name frame i)
+			:id 0
+			:value (debugger:frame-var-value frame i)))))
+
+(defimplementation frame-var-value (frame var)
+  (let ((frame (nth-frame frame)))
+    (debugger:frame-var-value frame var)))
+        
+(defimplementation frame-catch-tags (index)
+  (declare (ignore index))
+  nil)
+
+(defimplementation disassemble-frame (index)
+  (disassemble (debugger:frame-function (nth-frame index))))
+
+(defimplementation frame-source-location-for-emacs (index)
+  (let* ((frame (nth-frame index))
+         (expr (debugger:frame-expression frame))
+         (fspec (first expr)))
+    (second (first (fspec-definition-locations fspec)))))
+
+(defimplementation eval-in-frame (form frame-number)
+  (let ((frame (nth-frame frame-number)))
+    ;; let-bind lexical variables
+    (let ((vars (loop for i below (debugger:frame-number-vars frame)
+                      for name = (debugger:frame-var-name frame i)
+                      if (symbolp name)
+                      collect `(,name ',(debugger:frame-var-value frame i)))))
+      (debugger:eval-form-in-context 
+       `(let* ,vars ,form)
+       (debugger:environment-of-frame frame)))))
+
+(defimplementation return-from-frame (frame-number form)
+  (let ((frame (nth-frame frame-number)))
+    (multiple-value-call #'debugger:frame-return 
+      frame (debugger:eval-form-in-context 
+             form 
+             (debugger:environment-of-frame frame)))))
+
+(defimplementation restart-frame (frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (cond ((debugger:frame-retryable-p frame)
+           (apply #'debugger:frame-retry frame (debugger:frame-function frame)
+                  (cdr (debugger:frame-expression frame))))
+          (t "Frame is not retryable"))))
+
+;;;; Compiler hooks
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename* nil)
+
+(defun compiler-note-p (object)
+  (member (type-of object) '(excl::compiler-note compiler::compiler-note)))
+
+(defun compiler-undefined-functions-called-warning-p (object)
+  (typep object 'excl:compiler-undefined-functions-called-warning))
+
+(deftype compiler-note ()
+  `(satisfies compiler-note-p))
+
+(defun signal-compiler-condition (&rest args)
+  (signal (apply #'make-condition 'compiler-condition args)))
+
+(defun handle-compiler-warning (condition)
+  (declare (optimize (debug 3) (speed 0) (space 0)))
+  (cond ((and (not *buffer-name*) 
+              (compiler-undefined-functions-called-warning-p condition))
+         (handle-undefined-functions-warning condition))
+        (t
+         (signal-compiler-condition
+          :original-condition condition
+          :severity (etypecase condition
+                      (warning :warning)
+                      (compiler-note :note))
+          :message (format nil "~A" condition)
+          :location (location-for-warning condition)))))
+
+(defun location-for-warning (condition)
+  (let ((loc (getf (slot-value condition 'excl::plist) :loc)))
+    (cond (*buffer-name*
+           (make-location 
+            (list :buffer *buffer-name*)
+            (list :position *buffer-start-position*)))
+          (loc
+           (destructuring-bind (file . pos) loc
+             (make-location
+              (list :file (namestring (truename file)))
+              (list :position (1+ pos)))))
+          (t
+           (list :error "No error location available.")))))
+
+(defun handle-undefined-functions-warning (condition)
+  (let ((fargs (slot-value condition 'excl::format-arguments)))
+    (loop for (fname . pos-file) in (car fargs) do
+          (loop for (pos file) in pos-file do
+                (signal-compiler-condition
+                 :original-condition condition
+                 :severity :warning
+                 :message (format nil "Undefined function referenced: ~S" 
+                                  fname)
+                 :location (make-location (list :file file)
+                                          (list :position (1+ pos))))))))
+
+(defimplementation call-with-compilation-hooks (function)
+  (handler-bind ((warning #'handle-compiler-warning)
+                 ;;(compiler-note #'handle-compiler-warning)
+                 )
+    (funcall function)))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (with-compilation-hooks ()
+    (let ((*buffer-name* nil)
+          (*compile-filename* filename))
+      (compile-file *compile-filename* :load-after-compile load-p
+                    :external-format external-format))))
+
+(defun call-with-temp-file (fn)
+  (let ((tmpname (system:make-temp-file-name)))
+    (unwind-protect
+         (with-open-file (file tmpname :direction :output :if-exists :error)
+           (funcall fn file tmpname))
+      (delete-file tmpname))))
+
+(defun compile-from-temp-file (string)
+  (call-with-temp-file 
+   (lambda (stream filename)
+       (write-string string stream)
+       (finish-output stream)
+       (let ((binary-filename
+              (excl:without-redefinition-warnings
+                ;; Suppress Allegro's redefinition warnings; they are
+                ;; pointless when we are compiling via a temporary
+                ;; file.
+                (compile-file filename :load-after-compile t))))
+         (when binary-filename
+           (delete-file binary-filename))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  ;; We store the source buffer in excl::*source-pathname* as a string
+  ;; of the form <buffername>;<start-offset>.  Quite ugly encoding, but
+  ;; the fasl file is corrupted if we use some other datatype.
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-start-position* position)
+          (*buffer-string* string)
+          (*default-pathname-defaults*
+           (if directory (merge-pathnames (pathname directory))
+               *default-pathname-defaults*)))
+      (compile-from-temp-file
+       (format nil "~S ~S~%~A" 
+               `(in-package ,(package-name *package*))
+               `(eval-when (:compile-toplevel :load-toplevel)
+                 (setq excl::*source-pathname*
+                  ',(format nil "~A;~D" buffer position)))
+               string)))))
+
+;;;; Definition Finding
+
+(defun fspec-primary-name (fspec)
+  (etypecase fspec
+    (symbol fspec)
+    (list (fspec-primary-name (second fspec)))))
+
+;; If Emacs uses DOS-style eol conventions, \n\r are considered as a
+;; single character, but file-position counts them as two.  Here we do
+;; our own conversion.
+(defun count-cr (file pos)
+  (let* ((bufsize 256)
+         (type '(unsigned-byte 8))
+         (buf (make-array bufsize :element-type type))
+         (cr-count 0))
+  (with-open-file (stream file :direction :input :element-type type)
+    (loop for bytes-read = (read-sequence buf stream) do
+          (incf cr-count (count (char-code #\return) buf 
+                                :end (min pos bytes-read)))
+          (decf pos bytes-read)
+          (when (<= pos 0)
+            (return cr-count))))))
+              
+(defun find-definition-in-file (fspec type file top-level)
+  (let* ((part
+          (or (scm::find-definition-in-definition-group
+               fspec type (scm:section-file :file file)
+               :top-level top-level)
+              (scm::find-definition-in-definition-group
+               (fspec-primary-name fspec)
+               type (scm:section-file :file file)
+               :top-level top-level)))
+         (start (and part
+                     (scm::source-part-start part)))
+         (pos (if start
+                  (list :position (1+ (- start (count-cr file start))))
+                  (list :function-name (string (fspec-primary-name fspec))))))
+    (make-location (list :file (namestring (truename file)))
+                   pos)))
+  
+(defun find-definition-in-buffer (filename)
+  (let ((pos (position #\; filename :from-end t)))
+    (make-location
+     (list :buffer (subseq filename 0 pos))
+     (list :position (parse-integer (subseq filename (1+ pos)))))))
+
+(defun find-fspec-location (fspec type file top-level)
+  (etypecase file
+    (pathname
+     (find-definition-in-file fspec type file top-level))
+    ((member :top-level)
+     (list :error (format nil "Defined at toplevel: ~A"
+                          (fspec->string fspec))))
+    (string
+     (find-definition-in-buffer file))))
+
+(defun fspec->string (fspec)
+  (etypecase fspec
+    (symbol (let ((*package* (find-package :keyword)))
+              (prin1-to-string fspec)))
+    (list (format nil "(~A ~A)"
+                  (prin1-to-string (first fspec))
+                  (let ((*package* (find-package :keyword)))
+                    (prin1-to-string (second fspec)))))))
+
+(defun fspec-definition-locations (fspec)
+  (cond
+   ((and (listp fspec)
+         (eql (car fspec) :top-level-form))
+    (destructuring-bind (top-level-form file &optional position) fspec 
+      (list
+       (list (list nil fspec)
+             (make-location (list :buffer file)
+                            (list :position position t))))))
+   ((and (listp fspec) (eq (car fspec) :internal))
+    (destructuring-bind (_internal next _n) fspec
+      (fspec-definition-locations next)))
+   (t
+    (let ((defs (excl::find-source-file fspec)))
+      (if (null defs)
+          (list
+           (list (list nil fspec)
+                 (list :error
+                       (format nil "Unknown source location for ~A" 
+                               (fspec->string fspec)))))
+        (loop for (fspec type file top-level) in defs 
+              collect (list (list type fspec)
+                            (find-fspec-location fspec type file top-level))))))))
+
+(defimplementation find-definitions (symbol)
+  (fspec-definition-locations symbol))
+
+;;;; XREF
+
+(defmacro defxref (name relation name1 name2)
+  `(defimplementation ,name (x)
+    (xref-result (xref:get-relation ,relation ,name1 ,name2))))
+
+(defxref who-calls        :calls       :wild x)
+(defxref calls-who        :calls       x :wild)
+(defxref who-references   :uses        :wild x)
+(defxref who-binds        :binds       :wild x)
+(defxref who-macroexpands :macro-calls :wild x)
+(defxref who-sets         :sets        :wild x)
+
+(defun xref-result (fspecs)
+  (loop for fspec in fspecs
+        append (fspec-definition-locations fspec)))
+
+;; list-callers implemented by groveling through all fbound symbols.
+;; Only symbols are considered.  Functions in the constant pool are
+;; searched recursively.  Closure environments are ignored at the
+;; moment (constants in methods are therefore not found).
+
+(defun map-function-constants (function fn depth)
+  "Call FN with the elements of FUNCTION's constant pool."
+  (do ((i 0 (1+ i))
+       (max (excl::function-constant-count function)))
+      ((= i max))
+    (let ((c (excl::function-constant function i)))
+      (cond ((and (functionp c) 
+                  (not (eq c function))
+                  (plusp depth))
+             (map-function-constants c fn (1- depth)))
+            (t
+             (funcall fn c))))))
+
+(defun in-constants-p (fun symbol)
+  (map-function-constants fun 
+                          (lambda (c) 
+                            (when (eq c symbol) 
+                              (return-from in-constants-p t)))
+                          3))
+ 
+(defun function-callers (name)
+  (let ((callers '()))
+    (do-all-symbols (sym)
+      (when (fboundp sym)
+        (let ((fn (fdefinition sym)))
+          (when (in-constants-p fn name)
+            (push sym callers)))))
+    callers))
+
+(defimplementation list-callers (name)
+  (xref-result (function-callers name)))
+
+(defimplementation list-callees (name)
+  (let ((result '()))
+    (map-function-constants (fdefinition name)
+                            (lambda (c)
+                              (when (fboundp c)
+                                (push c result)))
+                            2)
+    (xref-result result)))
+
+;;;; Profiling
+
+;; Per-function profiling based on description in
+;;  http://www.franz.com/support/documentation/8.0/doc/runtime-analyzer.htm#data-collection-control-2
+
+(defvar *profiled-functions* ())
+(defvar *profile-depth* 0)
+
+(defmacro with-redirected-y-or-n-p (&body body)
+  ;; If the profiler is restarted when the data from the previous
+  ;; session is not reported yet, the user is warned via Y-OR-N-P.
+  ;; As the CL:Y-OR-N-P question is (for some reason) not directly
+  ;; sent to the Slime user, the function CL:Y-OR-N-P is temporarily
+  ;; overruled.
+  `(let* ((pkg       (find-package "common-lisp"))
+          (saved-pdl (excl::package-definition-lock pkg))
+          (saved-ynp (symbol-function 'cl:y-or-n-p)))
+     
+     (setf (excl::package-definition-lock pkg) nil
+           (symbol-function 'cl:y-or-n-p)   (symbol-function
+                                             (find-symbol "y-or-n-p-in-emacs"
+                                                          "swank")))
+     (unwind-protect
+         (progn , at body)
+       
+       (setf (symbol-function 'cl:y-or-n-p)      saved-ynp
+             (excl::package-definition-lock pkg) saved-pdl))))
+
+(defun start-acl-profiler ()
+  (with-redirected-y-or-n-p
+      (prof:start-profiler :type :time :count t
+                           :start-sampling-p nil :verbose nil)))
+(defun acl-profiler-active-p ()
+  (not (eq (prof:profiler-status :verbose nil) :inactive)))
+
+(defun stop-acl-profiler ()
+  (prof:stop-profiler :verbose nil))
+
+(excl:def-fwrapper profile-fwrapper (&rest args)
+  ;; Ensures sampling is done during the execution of the function,
+  ;; taking into account recursion.
+  (declare (ignore args))
+  (cond ((zerop *profile-depth*)
+         (let ((*profile-depth* (1+ *profile-depth*)))
+           (prof:start-sampling)
+           (unwind-protect (excl:call-next-fwrapper)
+             (prof:stop-sampling))))
+        (t 
+         (excl:call-next-fwrapper))))
+
+(defimplementation profile (fname)
+  (unless (acl-profiler-active-p)
+    (start-acl-profiler))
+  (excl:fwrap fname 'profile-fwrapper 'profile-fwrapper)
+  (push fname *profiled-functions*))
+
+(defimplementation profiled-functions ()
+  *profiled-functions*)
+
+(defimplementation unprofile (fname)
+  (excl:funwrap fname 'profile-fwrapper)
+  (setq *profiled-functions* (remove fname *profiled-functions*)))
+
+(defimplementation profile-report ()
+  (prof:show-flat-profile :verbose nil)
+  (when *profiled-functions*
+    (start-acl-profiler)))
+
+(defimplementation profile-reset ()
+  (when (acl-profiler-active-p)
+    (stop-acl-profiler)
+    (start-acl-profiler))
+  "Reset profiling counters.")
+
+;;;; Inspecting
+
+(defclass acl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'acl-inspector))
+
+(defmethod inspect-for-emacs ((f function) inspector)
+  inspector
+  (values "A function."
+          (append
+           (label-value-line "Name" (function-name f))
+           `("Formals" ,(princ-to-string (arglist f)) (:newline))
+           (let ((doc (documentation (excl::external-fn_symdef f) 'function)))
+             (when doc
+               `("Documentation:" (:newline) ,doc))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  inspector
+  (values "A value." (allegro-inspect o)))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+  inspector
+  (values "A function." (allegro-inspect o)))
+
+(defmethod inspect-for-emacs ((o standard-object) 
+                              (inspector backend-inspector))
+  inspector
+  (values (format nil "~A is a standard-object." o) (allegro-inspect o)))
+
+(defun allegro-inspect (o)
+  (loop for (d dd) on (inspect::inspect-ctl o)
+        append (frob-allegro-field-def o d)
+        until (eq d dd)))
+
+(defun frob-allegro-field-def (object def)
+  (with-struct (inspect::field-def- name type access) def
+    (ecase type
+      ((:unsigned-word :unsigned-byte :unsigned-natural
+                       :unsigned-long :unsigned-half-long 
+                       :unsigned-3byte)
+       (label-value-line name (inspect::component-ref-v object access type)))
+      ((:lisp :value)
+       (label-value-line name (inspect::component-ref object access)))
+      (:indirect 
+       (destructuring-bind (prefix count ref set) access
+         (declare (ignore set prefix))
+         (loop for i below (funcall count object)
+               append (label-value-line (format nil "~A-~D" name i)
+                                        (funcall ref object i))))))))
+
+;;;; Multithreading
+
+(defimplementation initialize-multiprocessing (continuation)
+  (mp:start-scheduler)
+  (funcall continuation))
+
+(defimplementation spawn (fn &key name)
+  (mp:process-run-function name fn))
+
+(defvar *id-lock* (mp:make-process-lock :name "id lock"))
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+  (mp:with-process-lock (*id-lock*)
+    (or (getf (mp:process-property-list thread) 'id)
+        (setf (getf (mp:process-property-list thread) 'id)
+              (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+  (find id mp:*all-processes*
+        :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
+(defimplementation thread-name (thread)
+  (mp:process-name thread))
+
+(defimplementation thread-status (thread)
+  (format nil "~A ~D" (mp:process-whostate thread)
+          (mp:process-priority thread)))
+
+(defimplementation make-lock (&key name)
+  (mp:make-process-lock :name name))
+
+(defimplementation call-with-lock-held (lock function)
+  (mp:with-process-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+  mp:*current-process*)
+
+(defimplementation all-threads ()
+  (copy-list mp:*all-processes*))
+
+(defimplementation interrupt-thread (thread fn)
+  (mp:process-interrupt thread fn))
+
+(defimplementation kill-thread (thread)
+  (mp:process-kill thread))
+
+(defvar *mailbox-lock* (mp:make-process-lock :name "mailbox lock"))
+
+(defstruct (mailbox (:conc-name mailbox.)) 
+  (mutex (mp:make-process-lock :name "process mailbox"))
+  (queue '() :type list))
+
+(defun mailbox (thread)
+  "Return THREAD's mailbox."
+  (mp:with-process-lock (*mailbox-lock*)
+    (or (getf (mp:process-property-list thread) 'mailbox)
+        (setf (getf (mp:process-property-list thread) 'mailbox)
+              (make-mailbox)))))
+
+(defimplementation send (thread message)
+  (let* ((mbox (mailbox thread))
+         (mutex (mailbox.mutex mbox)))
+    (mp:process-wait-with-timeout 
+     "yielding before sending" 0.1
+     (lambda ()
+       (mp:with-process-lock (mutex)
+         (< (length (mailbox.queue mbox)) 10))))
+    (mp:with-process-lock (mutex)
+      (setf (mailbox.queue mbox)
+            (nconc (mailbox.queue mbox) (list message))))))
+
+(defimplementation receive ()
+  (let* ((mbox (mailbox mp:*current-process*))
+         (mutex (mailbox.mutex mbox)))
+    (mp:process-wait "receive" #'mailbox.queue mbox)
+    (mp:with-process-lock (mutex)
+      (pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+  (excl:exit 0 :quiet t))
+
+
+;;Trace implementations
+;;In Allegro 7.0, we have:
+;; (trace <name>)
+;; (trace ((method <name> <qualifier>? (<specializer>+))))
+;; (trace ((labels <name> <label-name>)))
+;; (trace ((labels (method <name> (<specializer>+)) <label-name>)))
+;; <name> can be a normal name or a (setf name)
+
+(defimplementation toggle-trace (spec)
+  (ecase (car spec)
+    ((setf) 
+     (toggle-trace-aux spec))
+    (:defgeneric (toggle-trace-generic-function-methods (second spec)))
+    ((setf :defmethod :labels :flet) 
+     (toggle-trace-aux (process-fspec-for-allegro spec)))
+    (:call
+     (destructuring-bind (caller callee) (cdr spec)
+       (toggle-trace-aux callee 
+                         :inside (list (process-fspec-for-allegro caller)))))))
+
+(defun tracedp (fspec)
+  (member fspec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (fspec &rest args)
+  (cond ((tracedp fspec)
+         (eval `(untrace ,fspec))
+         (format nil "~S is now untraced." fspec))
+        (t
+         (eval `(trace (,fspec , at args)))
+         (format nil "~S is now traced." fspec))))
+
+(defun toggle-trace-generic-function-methods (name)
+  (let ((methods (mop:generic-function-methods (fdefinition name))))
+    (cond ((tracedp name)
+           (eval `(untrace ,name))
+           (dolist (method methods (format nil "~S is now untraced." name))
+             (excl:funtrace (mop:method-function method))))
+          (t
+           (eval `(trace (,name)))
+           (dolist (method methods (format nil "~S is now traced." name))
+             (excl:ftrace (mop:method-function method)))))))
+
+(defun process-fspec-for-allegro (fspec)
+  (cond ((consp fspec)
+         (ecase (first fspec)
+           ((setf) fspec)
+           ((:defun :defgeneric) (second fspec))
+           ((:defmethod) `(method ,@(rest fspec)))
+           ((:labels) `(labels ,(process-fspec-for-allegro (second fspec))
+                         ,(third fspec)))
+           ((:flet) `(flet ,(process-fspec-for-allegro (second fspec)) 
+                       ,(third fspec)))))
+        (t
+         fspec)))
+
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+  (apply #'make-hash-table :weak-keys t args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+  (apply #'make-hash-table :values :weak args))
+
+(defimplementation hash-table-weakness (hashtable)
+  (cond ((excl:hash-table-weak-keys hashtable) :key)
+        ((eq (excl:hash-table-values hashtable) :weak) :value)))
+
+
+
+;;;; Character names
+
+(defimplementation character-completion-set (prefix matchp)
+  (loop for name being the hash-keys of excl::*name-to-char-table*
+       when (funcall matchp prefix name)
+       collect (string-capitalize name)))

Added: branches/trunk-reorg/thirdparty/slime/swank-backend.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-backend.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-backend.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1077 @@
+;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
+;;;
+;;; slime-backend.lisp --- SLIME backend interface.
+;;;
+;;; Created by James Bielman in 2003. Released into the public domain.
+;;;
+;;;; Frontmatter
+;;;
+;;; This file defines the functions that must be implemented
+;;; separately for each Lisp. Each is declared as a generic function
+;;; for which swank-<implementation>.lisp provides methods.
+
+(defpackage :swank-backend
+  (:use :common-lisp)
+  (:export #:sldb-condition
+           #:original-condition
+           #:compiler-condition
+           #:message
+           #:short-message
+           #:condition
+           #:severity
+           #:with-compilation-hooks
+           #:location
+           #:location-p
+           #:location-buffer
+           #:location-position
+           #:position-p
+           #:position-pos
+           #:print-output-to-string
+           #:quit-lisp
+           #:references
+           #:unbound-slot-filler
+           #:declaration-arglist
+           #:type-specifier-arglist
+           ;; inspector related symbols
+           #:inspector
+           #:backend-inspector
+           #:inspect-for-emacs
+           #:raw-inspection
+           #:fancy-inspection
+           #:label-value-line
+           #:label-value-line*
+           #:with-struct
+           ))
+
+(defpackage :swank-mop
+  (:use)
+  (:export
+   ;; classes
+   #:standard-generic-function
+   #:standard-slot-definition
+   #:standard-method
+   #:standard-class
+   #:eql-specializer
+   #:eql-specializer-object
+   ;; standard-class readers
+   #:class-default-initargs
+   #:class-direct-default-initargs
+   #:class-direct-slots
+   #:class-direct-subclasses
+   #:class-direct-superclasses
+   #:class-finalized-p
+   #:class-name
+   #:class-precedence-list
+   #:class-prototype
+   #:class-slots
+   #:specializer-direct-methods
+   ;; generic function readers
+   #:generic-function-argument-precedence-order
+   #:generic-function-declarations
+   #:generic-function-lambda-list
+   #:generic-function-methods
+   #:generic-function-method-class
+   #:generic-function-method-combination
+   #:generic-function-name
+   ;; method readers
+   #:method-generic-function
+   #:method-function
+   #:method-lambda-list
+   #:method-specializers
+   #:method-qualifiers
+   ;; slot readers
+   #:slot-definition-allocation
+   #:slot-definition-documentation
+   #:slot-definition-initargs
+   #:slot-definition-initform
+   #:slot-definition-initfunction
+   #:slot-definition-name
+   #:slot-definition-type
+   #:slot-definition-readers
+   #:slot-definition-writers
+   #:slot-boundp-using-class
+   #:slot-value-using-class
+   #:slot-makunbound-using-class
+   ;; generic function protocol
+   #:compute-applicable-methods-using-classes
+   #:finalize-inheritance))
+
+(in-package :swank-backend)
+
+
+;;;; Metacode
+
+(defparameter *interface-functions* '()
+  "The names of all interface functions.")
+
+(defparameter *unimplemented-interfaces* '()
+  "List of interface functions that are not implemented.
+DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
+
+(defmacro definterface (name args documentation &rest default-body)
+  "Define an interface function for the backend to implement.
+A function is defined with NAME, ARGS, and DOCUMENTATION.  This
+function first looks for a function to call in NAME's property list
+that is indicated by 'IMPLEMENTATION; failing that, it looks for a
+function indicated by 'DEFAULT. If neither is present, an error is
+signaled.
+
+If a DEFAULT-BODY is supplied, then a function with the same body and
+ARGS will be added to NAME's property list as the property indicated
+by 'DEFAULT.
+
+Backends implement these functions using DEFIMPLEMENTATION."
+  (check-type documentation string "a documentation string")
+  (assert (every #'symbolp args) ()
+          "Complex lambda-list not supported: ~S ~S" name args)
+  (labels ((gen-default-impl ()
+             `(setf (get ',name 'default) (lambda ,args , at default-body)))
+           (args-as-list (args)
+             (destructuring-bind (req opt key rest) (parse-lambda-list args)
+               `(, at req , at opt 
+                       ,@(loop for k in key append `(,(kw k) ,k)) 
+                       ,@(or rest '(())))))
+           (parse-lambda-list (args)
+             (parse args '(&optional &key &rest) 
+                    (make-array 4 :initial-element nil)))
+           (parse (args keywords vars)
+             (cond ((null args) 
+                    (reverse (map 'list #'reverse vars)))
+                   ((member (car args) keywords)
+                    (parse (cdr args) (cdr (member (car args) keywords)) vars))
+                   (t (push (car args) (aref vars (length keywords)))
+                      (parse (cdr args) keywords vars))))
+           (kw (s) (intern (string s) :keyword)))
+    `(progn 
+       (defun ,name ,args
+         ,documentation
+         (let ((f (or (get ',name 'implementation)
+                      (get ',name 'default))))
+           (cond (f (apply f ,@(args-as-list args)))
+                 (t (error "~S not implementated" ',name)))))
+       (pushnew ',name *interface-functions*)
+       ,(if (null default-body)
+            `(pushnew ',name *unimplemented-interfaces*)
+            (gen-default-impl))
+       ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
+       (eval-when (:compile-toplevel :load-toplevel :execute)
+         (export ',name :swank-backend))
+       ',name)))
+
+(defmacro defimplementation (name args &body body)
+  (assert (every #'symbolp args) ()
+          "Complex lambda-list not supported: ~S ~S" name args)
+  `(progn
+     (setf (get ',name 'implementation) (lambda ,args , at body))
+     (if (member ',name *interface-functions*)
+         (setq *unimplemented-interfaces*
+               (remove ',name *unimplemented-interfaces*))
+         (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
+     ',name))
+
+(defun warn-unimplemented-interfaces ()
+  "Warn the user about unimplemented backend features.
+The portable code calls this function at startup."
+  (warn "These Swank interfaces are unimplemented:~% ~A"
+        (sort (copy-list *unimplemented-interfaces*) #'string<)))
+
+(defun import-to-swank-mop (symbol-list)
+  (dolist (sym symbol-list)
+    (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
+      (when swank-mop-sym
+        (unintern swank-mop-sym :swank-mop))
+      (import sym :swank-mop)
+      (export sym :swank-mop))))
+
+(defun import-swank-mop-symbols (package except)
+  "Import the mop symbols from PACKAGE to SWANK-MOP.
+EXCEPT is a list of symbol names which should be ignored."
+  (do-symbols (s :swank-mop)
+    (unless (member s except :test #'string=)
+      (let ((real-symbol (find-symbol (string s) package)))
+        (assert real-symbol () "Symbol ~A not found in package ~A" s package)
+        (unintern s :swank-mop)
+        (import real-symbol :swank-mop)
+        (export real-symbol :swank-mop)))))
+
+(defvar *gray-stream-symbols*
+  '(:fundamental-character-output-stream
+    :stream-write-char
+    :stream-fresh-line
+    :stream-force-output
+    :stream-finish-output
+    :fundamental-character-input-stream
+    :stream-read-char
+    :stream-listen
+    :stream-unread-char
+    :stream-clear-input
+    :stream-line-column
+    :stream-read-char-no-hang
+    ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
+    ;; supported by CMUCL, OpenMCL, SBCL and SCL.
+    #+(or cmu openmcl sbcl scl)
+    :stream-line-length))
+
+(defun import-from (package symbol-names &optional (to-package *package*))
+  "Import the list of SYMBOL-NAMES found in the package PACKAGE."
+  (dolist (name symbol-names)
+    (multiple-value-bind (symbol found) (find-symbol (string name) package)
+      (assert found () "Symbol ~A not found in package ~A" name package)
+      (import symbol to-package))))
+
+
+;;;; Utilities
+
+(defmacro with-struct ((conc-name &rest names) obj &body body)
+  "Like with-slots but works only for structs."
+  (flet ((reader (slot) (intern (concatenate 'string
+					     (symbol-name conc-name)
+					     (symbol-name slot))
+				(symbol-package conc-name))))
+    (let ((tmp (gensym "OO-")))
+    ` (let ((,tmp ,obj))
+        (symbol-macrolet
+            ,(loop for name in names collect 
+                   (typecase name
+                     (symbol `(,name (,(reader name) ,tmp)))
+                     (cons `(,(first name) (,(reader (second name)) ,tmp)))
+                     (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
+          , at body)))))
+
+
+;;;; TCP server
+
+(definterface create-socket (host port)
+  "Create a listening TCP socket on interface HOST and port PORT .")
+
+(definterface local-port (socket)
+  "Return the local port number of SOCKET.")
+
+(definterface close-socket (socket)
+  "Close the socket SOCKET.")
+
+(definterface accept-connection (socket &key external-format
+                                        buffering timeout)
+   "Accept a client connection on the listening socket SOCKET.  
+Return a stream for the new connection.")
+
+(definterface add-sigio-handler (socket fn)
+  "Call FN whenever SOCKET is readable.")
+
+(definterface remove-sigio-handlers (socket)
+  "Remove all sigio handlers for SOCKET.")
+
+(definterface add-fd-handler (socket fn)
+  "Call FN when Lisp is waiting for input and SOCKET is readable.")
+
+(definterface remove-fd-handlers (socket)
+  "Remove all fd-handlers for SOCKET.")
+
+(definterface preferred-communication-style ()
+  "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
+  nil)
+
+(definterface set-stream-timeout (stream timeout)
+  "Set the 'stream 'timeout.  The timeout is either the real number
+  specifying the timeout in seconds or 'nil for no timeout."
+  (declare (ignore stream timeout))
+  nil)
+
+;;; Base condition for networking errors.
+(define-condition network-error (simple-error) ())
+
+(definterface emacs-connected ()
+   "Hook called when the first connection from Emacs is established.
+Called from the INIT-FN of the socket server that accepts the
+connection.
+
+This is intended for setting up extra context, e.g. to discover
+that the calling thread is the one that interacts with Emacs."
+   nil)
+
+
+;;;; Unix signals
+
+(defconstant +sigint+ 2)
+
+(definterface call-without-interrupts (fn)
+  "Call FN in a context where interrupts are disabled."
+  (funcall fn))
+
+(definterface getpid ()
+  "Return the (Unix) process ID of this superior Lisp.")
+
+(definterface lisp-implementation-type-name ()
+  "Return a short name for the Lisp implementation."
+  (lisp-implementation-type))
+
+(definterface default-directory ()
+  "Return the default directory."
+  (directory-namestring (truename *default-pathname-defaults*)))
+
+(definterface set-default-directory (directory)
+  "Set the default directory.
+This is used to resolve filenames without directory component."
+  (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
+  (default-directory))
+
+(definterface call-with-syntax-hooks (fn)
+  "Call FN with hooks to handle special syntax."
+  (funcall fn))
+
+(definterface default-readtable-alist ()
+  "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
+  '())
+
+(definterface quit-lisp ()
+  "Exit the current lisp image.")
+
+
+;;;; Compilation
+
+(definterface call-with-compilation-hooks (func)
+  "Call FUNC with hooks to record compiler conditions.")
+
+(defmacro with-compilation-hooks ((&rest ignore) &body body)
+  "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
+  (declare (ignore ignore))
+  `(call-with-compilation-hooks (lambda () (progn , at body))))
+
+(definterface swank-compile-string (string &key buffer position directory)
+  "Compile source from STRING.  During compilation, compiler
+conditions must be trapped and resignalled as COMPILER-CONDITIONs.
+
+If supplied, BUFFER and POSITION specify the source location in Emacs.
+
+Additionally, if POSITION is supplied, it must be added to source
+positions reported in compiler conditions.
+
+If DIRECTORY is specified it may be used by certain implementations to
+rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
+source information.")
+
+(definterface swank-compile-file (filename load-p external-format)
+   "Compile FILENAME signalling COMPILE-CONDITIONs.
+If LOAD-P is true, load the file after compilation.
+EXTERNAL-FORMAT is a value returned by find-external-format or
+:default.")
+
+(deftype severity () 
+  '(member :error :read-error :warning :style-warning :note))
+
+;; Base condition type for compiler errors, warnings and notes.
+(define-condition compiler-condition (condition)
+  ((original-condition
+    ;; The original condition thrown by the compiler if appropriate.
+    ;; May be NIL if a compiler does not report using conditions.
+    :type (or null condition)
+    :initarg :original-condition
+    :accessor original-condition)
+
+   (severity :type severity
+             :initarg :severity
+             :accessor severity)
+
+   (message :initarg :message
+            :accessor message)
+
+   (short-message :initarg :short-message
+                  :initform nil
+                  :accessor short-message)
+
+   (references :initarg :references
+               :initform nil
+               :accessor references)
+
+   (location :initarg :location
+             :accessor location)))
+
+(definterface find-external-format (coding-system)
+  "Return a \"external file format designator\" for CODING-SYSTEM.
+CODING-SYSTEM is Emacs-style coding system name (a string),
+e.g. \"latin-1-unix\"."
+  (if (equal coding-system "iso-latin-1-unix")
+      :default
+      nil))
+
+(definterface guess-external-format (filename)
+  "Detect the external format for the file with name FILENAME.
+Return nil if the file contains no special markers."
+  ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
+  (with-open-file (s filename :if-does-not-exist nil
+                     :external-format (or (find-external-format "latin-1-unix")
+                                          :default))
+    (if s 
+        (or (let* ((line (read-line s nil))
+                   (p (search "-*-" line)))
+              (when p
+                (let* ((start (+ p (length "-*-")))
+                       (end (search "-*-" line :start2 start)))
+                  (when end
+                    (%search-coding line start end)))))
+            (let* ((len (file-length s))
+                   (buf (make-string (min len 3000))))
+              (file-position s (- len (length buf)))
+              (read-sequence buf s)
+              (let ((start (search "Local Variables:" buf :from-end t))
+                    (end (search "End:" buf :from-end t)))
+                (and start end (< start end)
+                     (%search-coding buf start end))))))))
+
+(defun %search-coding (str start end)
+  (let ((p (search "coding:" str :start2 start :end2 end)))
+    (when p
+      (incf p (length "coding:"))
+      (loop while (and (< p end)
+                       (member (aref str p) '(#\space #\tab)))
+            do (incf p))
+      (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
+                              str :start p)))
+        (find-external-format (subseq str p end))))))
+
+
+;;;; Streams
+
+(definterface make-fn-streams (input-fn output-fn)
+   "Return character input and output streams backended by functions.
+When input is needed, INPUT-FN is called with no arguments to
+return a string.
+When output is ready, OUTPUT-FN is called with the output as its
+argument.
+
+Output should be forced to OUTPUT-FN before calling INPUT-FN.
+
+The streams are returned as two values.")
+
+(definterface make-stream-interactive (stream)
+  "Do any necessary setup to make STREAM work interactively.
+This is called for each stream used for interaction with the user
+\(e.g. *standard-output*). An implementation could setup some
+implementation-specific functions to control output flushing at the
+like."
+  (declare (ignore stream))
+  nil)
+
+
+;;;; Documentation
+
+(definterface arglist (name)
+   "Return the lambda list for the symbol NAME. NAME can also be
+a lisp function object, on lisps which support this.
+
+The result can be a list or the :not-available keyword if the
+arglist cannot be determined."
+   (declare (ignore name))
+   :not-available)
+
+(defgeneric declaration-arglist (decl-identifier)
+  (:documentation
+   "Return the argument list of the declaration specifier belonging to the
+declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
+the keyword :NOT-AVAILABLE is returned.
+
+The different SWANK backends can specialize this generic function to
+include implementation-dependend declaration specifiers, or to provide
+additional information on the specifiers defined in ANSI Common Lisp.")
+  (:method (decl-identifier)
+    (case decl-identifier
+      (dynamic-extent '(&rest vars))
+      (ignore         '(&rest vars))
+      (ignorable      '(&rest vars))
+      (special        '(&rest vars))
+      (inline         '(&rest function-names))
+      (notinline      '(&rest function-name))
+      (optimize       '(&any compilation-speed debug safety space speed))  
+      (type           '(type-specifier &rest args))
+      (ftype          '(type-specifier &rest function-names))
+      (otherwise
+       (flet ((typespec-p (symbol) (member :type (describe-symbol-for-emacs symbol))))
+         (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
+                '(&rest vars))
+               ((and (listp decl-identifier) (typespec-p (first decl-identifier)))
+                '(&rest vars))
+               (t :not-available)))))))
+
+(defgeneric type-specifier-arglist (typespec-operator)
+  (:documentation
+   "Return the argument list of the type specifier belonging to
+TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
+:NOT-AVAILABLE is returned.
+
+The different SWANK backends can specialize this generic function to
+include implementation-dependend declaration specifiers, or to provide
+additional information on the specifiers defined in ANSI Common Lisp.")
+  (:method (typespec-operator)
+    (declare (special *type-specifier-arglists*)) ; defined at end of file.
+    (typecase typespec-operator
+      (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
+                  :not-available))
+      (t :not-available))))
+
+(definterface function-name (function)
+  "Return the name of the function object FUNCTION.
+
+The result is either a symbol, a list, or NIL if no function name is available."
+  (declare (ignore function))
+  nil)
+
+(definterface macroexpand-all (form)
+   "Recursively expand all macros in FORM.
+Return the resulting form.")
+
+(definterface compiler-macroexpand-1 (form &optional env)
+  "Call the compiler-macro for form.
+If FORM is a function call for which a compiler-macro has been
+defined, invoke the expander function using *macroexpand-hook* and
+return the results and T.  Otherwise, return the original form and
+NIL."
+  (let ((fun (and (consp form) (compiler-macro-function (car form)))))
+    (if fun
+	(let ((result (funcall *macroexpand-hook* fun form env)))
+          (values result (not (eq result form))))
+	(values form nil))))
+
+(definterface compiler-macroexpand (form &optional env)
+  "Repetitively call `compiler-macroexpand-1'."
+  (labels ((frob (form expanded)
+	     (multiple-value-bind (new-form newly-expanded)
+		 (compiler-macroexpand-1 form env)
+	       (if newly-expanded
+		   (frob new-form t)
+		   (values new-form expanded)))))
+    (frob form env)))
+
+(definterface describe-symbol-for-emacs (symbol)
+   "Return a property list describing SYMBOL.
+
+The property list has an entry for each interesting aspect of the
+symbol. The recognised keys are:
+
+  :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
+  :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
+
+The value of each property is the corresponding documentation string,
+or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
+slime-print-apropos in Emacs must know about them).
+
+Properties should be included if and only if they are applicable to
+the symbol. For example, only (and all) fbound symbols should include
+the :FUNCTION property.
+
+Example:
+\(describe-symbol-for-emacs 'vector)
+  => (:CLASS :NOT-DOCUMENTED
+      :TYPE :NOT-DOCUMENTED
+      :FUNCTION \"Constructs a simple-vector from the given objects.\")")
+
+(definterface describe-definition (name type)
+  "Describe the definition NAME of TYPE.
+TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
+
+Return a documentation string, or NIL if none is available.")
+
+
+;;;; Debugging
+
+(definterface install-debugger-globally (function)
+  "Install FUNCTION as the debugger for all threads/processes. This
+usually involves setting *DEBUGGER-HOOK* and, if the implementation
+permits, hooking into BREAK as well."
+  (setq *debugger-hook* function))
+
+(definterface call-with-debugging-environment (debugger-loop-fn)
+   "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
+
+This function is called recursively at each debug level to invoke the
+debugger loop. The purpose is to setup any necessary environment for
+other debugger callbacks that will be called within the debugger loop.
+
+For example, this is a reasonable place to compute a backtrace, switch
+to safe reader/printer settings, and so on.")
+
+(definterface call-with-debugger-hook (hook fun)
+  "Call FUN and use HOOK as debugger hook.
+
+HOOK should be called for both BREAK and INVOKE-DEBUGGER."
+  (let ((*debugger-hook* hook))
+    (funcall fun)))
+
+(define-condition sldb-condition (condition)
+  ((original-condition
+    :initarg :original-condition
+    :accessor original-condition))
+  (:report (lambda (condition stream)
+             (format stream "Condition in debugger code~@[: ~A~]" 
+                     (original-condition condition))))
+  (:documentation
+   "Wrapper for conditions that should not be debugged.
+
+When a condition arises from the internals of the debugger, it is not
+desirable to debug it -- we'd risk entering an endless loop trying to
+debug the debugger! Instead, such conditions can be reported to the
+user without (re)entering the debugger by wrapping them as
+`sldb-condition's."))
+
+(definterface compute-backtrace (start end)
+   "Return a list containing a backtrace of the condition current
+being debugged.  The results are unspecified if this function is
+called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
+
+START and END are zero-based indices constraining the number of frames
+returned.  Frame zero is defined as the frame which invoked the
+debugger.  If END is nil, return the frames from START to the end of
+the stack.")
+
+(definterface compute-sane-restarts (condition)
+  "This is an opportunity for Lisps such as CLISP to remove
+unwanted restarts from the output of CL:COMPUTE-RESTARTS,
+otherwise it should simply call CL:COMPUTE-RESTARTS, which is
+what the default implementation does."
+  (compute-restarts condition))
+
+(definterface print-frame (frame stream)
+  "Print frame to stream.")
+
+(definterface frame-source-location-for-emacs (frame-number)
+  "Return the source location for FRAME-NUMBER.")
+
+(definterface frame-catch-tags (frame-number)
+  "Return a list of XXX list of what? catch tags for a debugger
+stack frame.  The results are undefined unless this is called
+within the dynamic contour of a function defined by
+DEFINE-DEBUGGER-HOOK.")
+
+(definterface frame-locals (frame-number)
+  "Return a list of XXX local variable designators define me
+for a debugger stack frame.  The results are undefined unless
+this is called within the dynamic contour of a function defined
+by DEFINE-DEBUGGER-HOOK.")
+
+(definterface frame-var-value (frame var)
+  "Return the value of VAR in FRAME.  
+FRAME is the number of the frame in the backtrace.
+VAR is the number of the variable in the frame.")
+
+(definterface disassemble-frame (frame-number)
+  "Disassemble the code for the FRAME-NUMBER.
+The output should be written to standard output.
+FRAME-NUMBER is a non-negative integer.")
+
+(definterface eval-in-frame (form frame-number)
+   "Evaluate a Lisp form in the lexical context of a stack frame
+in the debugger.  The results are undefined unless called in the
+dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
+
+FRAME-NUMBER must be a positive integer with 0 indicating the
+frame which invoked the debugger.
+
+The return value is the result of evaulating FORM in the
+appropriate context.")
+
+(definterface return-from-frame (frame-number form)
+  "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
+produced by evaluating FORM in the frame context to its caller.
+
+Execute any clean-up code from unwind-protect forms above the frame
+during unwinding.
+
+Return a string describing the error if it's not possible to return
+from the frame.")
+
+(definterface restart-frame (frame-number)
+  "Restart execution of the frame FRAME-NUMBER with the same arguments
+as it was called originally.")
+
+(definterface format-sldb-condition (condition)
+  "Format a condition for display in SLDB."
+  (princ-to-string condition))
+
+(definterface condition-extras (condition)
+  "Return a list of extra for the debugger.
+The allowed elements are of the form:
+  (:SHOW-FRAME-SOURCE frame-number)
+  (:REFERENCES &rest refs)
+"
+  (declare (ignore condition))
+  '())
+
+(definterface activate-stepping (frame-number)
+  "Prepare the frame FRAME-NUMBER for stepping.")
+
+(definterface sldb-break-on-return (frame-number)
+  "Set a breakpoint in the frame FRAME-NUMBER.")
+
+(definterface sldb-break-at-start (symbol)
+  "Set a breakpoint on the beginning of the function for SYMBOL.")
+  
+(definterface sldb-stepper-condition-p (condition)
+  "Return true if SLDB was invoked due to a single-stepping condition,
+false otherwise. "
+  (declare (ignore condition))
+  nil)
+
+(definterface sldb-step-into ()
+  "Step into the current single-stepper form.")
+
+(definterface sldb-step-next ()
+  "Step to the next form in the current function.")
+
+(definterface sldb-step-out ()
+  "Stop single-stepping temporarily, but resume it once the current function
+returns.")
+
+
+;;;; Definition finding
+
+(defstruct (:location (:type list) :named
+                      (:constructor make-location
+                                    (buffer position &optional hints)))
+  buffer position
+  ;; Hints is a property list optionally containing:
+  ;;   :snippet SOURCE-TEXT
+  ;;     This is a snippet of the actual source text at the start of
+  ;;     the definition, which could be used in a text search.
+  hints)
+
+(defstruct (:error (:type list) :named (:constructor)) message)
+(defstruct (:file (:type list) :named (:constructor)) name)
+(defstruct (:buffer (:type list) :named (:constructor)) name)
+(defstruct (:position (:type list) :named (:constructor)) pos)
+
+(definterface find-definitions (name)
+   "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
+
+NAME is a \"definition specifier\".
+
+DSPEC is a \"definition specifier\" describing the
+definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
+\(DEFVAR FOO).
+
+LOCATION is the source location for the definition.")
+
+(definterface buffer-first-change (filename)
+  "Called for effect the first time FILENAME's buffer is modified."
+  (declare (ignore filename))
+  nil)
+
+
+;;;; XREF
+
+(definterface who-calls (function-name)
+  "Return the call sites of FUNCTION-NAME (a symbol).
+The results is a list ((DSPEC LOCATION) ...).")
+
+(definterface calls-who (function-name)
+  "Return the call sites of FUNCTION-NAME (a symbol).
+The results is a list ((DSPEC LOCATION) ...).")
+
+(definterface who-references (variable-name)
+  "Return the locations where VARIABLE-NAME (a symbol) is referenced.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-binds (variable-name)
+  "Return the locations where VARIABLE-NAME (a symbol) is bound.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-sets (variable-name)
+  "Return the locations where VARIABLE-NAME (a symbol) is set.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-macroexpands (macro-name)
+  "Return the locations where MACRO-NAME (a symbol) is expanded.
+See WHO-CALLS for a description of the return value.")
+
+(definterface who-specializes (class-name)
+  "Return the locations where CLASS-NAME (a symbol) is specialized.
+See WHO-CALLS for a description of the return value.")
+
+;;; Simpler variants.
+
+(definterface list-callers (function-name)
+  "List the callers of FUNCTION-NAME.
+This function is like WHO-CALLS except that it is expected to use
+lower-level means. Whereas WHO-CALLS is usually implemented with
+special compiler support, LIST-CALLERS is usually implemented by
+groveling for constants in function objects throughout the heap.
+
+The return value is as for WHO-CALLS.")
+
+(definterface list-callees (function-name)
+  "List the functions called by FUNCTION-NAME.
+See LIST-CALLERS for a description of the return value.")
+
+
+;;;; Profiling
+
+;;; The following functions define a minimal profiling interface.
+
+(definterface profile (fname)
+  "Marks symbol FNAME for profiling.")
+
+(definterface profiled-functions ()
+  "Returns a list of profiled functions.")
+
+(definterface unprofile (fname)
+  "Marks symbol FNAME as not profiled.")
+
+(definterface unprofile-all ()
+  "Marks all currently profiled functions as not profiled."
+  (dolist (f (profiled-functions))
+    (unprofile f)))
+
+(definterface profile-report ()
+  "Prints profile report.")
+
+(definterface profile-reset ()
+  "Resets profile counters.")
+
+(definterface profile-package (package callers-p methods)
+  "Wrap profiling code around all functions in PACKAGE.  If a function
+is already profiled, then unprofile and reprofile (useful to notice
+function redefinition.)
+
+If CALLERS-P is T names have counts of the most common calling
+functions recorded.
+
+When called with arguments :METHODS T, profile all methods of all
+generic functions having names in the given package.  Generic functions
+themselves, that is, their dispatch functions, are left alone.")
+
+
+;;;; Inspector
+
+(defclass inspector ()
+  ()
+  (:documentation "Super class of inspector objects.
+
+Implementations should sub class in order to dispatch off of the
+inspect-for-emacs method."))
+
+(defclass backend-inspector (inspector) ())
+
+(definterface make-default-inspector ()
+  "Return an inspector object suitable for passing to inspect-for-emacs.")
+
+(defgeneric inspect-for-emacs (object inspector)
+  (:documentation
+   "Explain to Emacs how to inspect OBJECT.
+
+The argument INSPECTOR is an object representing how to get at
+the internals of OBJECT, it is usually an implementation specific
+class used simply for dispatching to the proper method.
+
+Returns two values: a string which will be used as the title of
+the inspector buffer and a list specifying how to render the
+object for inspection.
+
+Every element of the list must be either a string, which will be
+inserted into the buffer as is, or a list of the form:
+
+ (:value object &optional format) - Render an inspectable
+ object. If format is provided it must be a string and will be
+ rendered in place of the value, otherwise use princ-to-string.
+
+ (:newline) - Render a \\n
+
+ (:action label lambda &key (refresh t)) - Render LABEL (a text
+ string) which when clicked will call LAMBDA. If REFRESH is
+ non-NIL the currently inspected object will be re-inspected
+ after calling the lambda.
+
+ NIL - do nothing."))
+
+(defmethod inspect-for-emacs ((object t) (inspector t))
+  "Generic method for inspecting any kind of object.
+
+Since we don't know how to deal with OBJECT we simply dump the
+output of CL:DESCRIBE."
+  (declare (ignore inspector))
+  (values 
+   "A value."
+   `("Type: " (:value ,(type-of object)) (:newline)
+     "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
+     (:newline) (:newline)
+     ,(with-output-to-string (desc) (describe object desc)))))
+
+;;; Utilities for inspector methods.
+;;; 
+(defun label-value-line (label value &key (newline t))
+  "Create a control list which prints \"LABEL: VALUE\" in the inspector.
+If NEWLINE is non-NIL a `(:newline)' is added to the result."
+  (list* (princ-to-string label) ": " `(:value ,value)
+         (if newline '((:newline)) nil)))
+
+(defmacro label-value-line* (&rest label-values)
+  ` (append ,@(loop for (label value) in label-values
+                    collect `(label-value-line ,label ,value))))
+
+(definterface describe-primitive-type (object)
+  "Return a string describing the primitive type of object."
+  (declare (ignore object))
+  "N/A")
+
+
+;;;; Multithreading
+;;;
+;;; The default implementations are sufficient for non-multiprocessing
+;;; implementations.
+
+(definterface initialize-multiprocessing (continuation)
+   "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
+
+Depending on the impleimentaion, this function may never return."
+   (funcall continuation))
+
+(definterface spawn (fn &key name)
+  "Create a new thread to call FN.")
+
+(definterface thread-id (thread)
+  "Return an Emacs-parsable object to identify THREAD.
+
+Ids should be comparable with equal, i.e.:
+ (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
+
+(definterface find-thread (id)
+  "Return the thread for ID.
+ID should be an id previously obtained with THREAD-ID.
+Can return nil if the thread no longer exists.")
+
+(definterface thread-name (thread)
+   "Return the name of THREAD.
+
+Thread names are be single-line strings and are meaningful to the
+user. They do not have to be unique."
+   (declare (ignore thread))
+   "The One True Thread")
+
+(definterface thread-status (thread)
+   "Return a string describing THREAD's state."
+   (declare (ignore thread))
+   "")
+
+(definterface make-lock (&key name)
+   "Make a lock for thread synchronization.
+Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
+   (declare (ignore name))
+   :null-lock)
+
+(definterface call-with-lock-held (lock function)
+   "Call FUNCTION with LOCK held, queueing if necessary."
+   (declare (ignore lock)
+            (type function function))
+   (funcall function))
+
+(definterface make-recursive-lock (&key name)
+  "Make a lock for thread synchronization.
+Only one thread may hold the lock (via CALL-WITH-RECURSIVE-LOCK-HELD)
+at a time, but that thread may hold it more than once."
+  (cons nil (make-lock :name name)))
+
+(definterface call-with-recursive-lock-held (lock function)
+  "Call FUNCTION with LOCK held, queueing if necessary."
+  (if (eql (car lock) (current-thread))
+      (funcall function)
+      (call-with-lock-held (cdr lock)
+                           (lambda ()
+                             (unwind-protect
+                                  (progn
+                                    (setf (car lock) (current-thread))
+                                    (funcall function))
+                               (setf (car lock) nil))))))
+
+(definterface current-thread ()
+  "Return the currently executing thread."
+  0)
+
+(definterface all-threads ()
+  "Return a list of all threads.")
+
+(definterface thread-alive-p (thread)
+  "Test if THREAD is termintated."
+  (member thread (all-threads)))
+
+(definterface interrupt-thread (thread fn)
+  "Cause THREAD to execute FN.")
+
+(definterface kill-thread (thread)
+  "Kill THREAD."
+  (declare (ignore thread))
+  nil)
+
+(definterface send (thread object)
+  "Send OBJECT to thread THREAD.")
+
+(definterface receive ()
+  "Return the next message from current thread's mailbox.")
+
+(definterface toggle-trace (spec)
+  "Toggle tracing of the function(s) given with SPEC.
+SPEC can be:
+ (setf NAME)                            ; a setf function
+ (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
+ (:defgeneric NAME)                     ; a generic function with all methods
+ (:call CALLER CALLEE)                  ; trace calls from CALLER to CALLEE.
+ (:labels TOPLEVEL LOCAL) 
+ (:flet TOPLEVEL LOCAL) ")
+
+
+;;;; Weak datastructures
+
+(definterface make-weak-key-hash-table (&rest args)
+  "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
+  (apply #'make-hash-table args))
+
+(definterface make-weak-value-hash-table (&rest args)
+  "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
+  (apply #'make-hash-table args))
+
+(definterface hash-table-weakness (hashtable)
+  "Return nil or one of :key :value :key-or-value :key-and-value"
+  (declare (ignore hashtable))
+  nil)
+
+
+;;;; Character names
+
+(definterface character-completion-set (prefix matchp)
+  "Return a list of names of characters that match PREFIX."
+  ;; Handle the standard and semi-standard characters.
+  (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
+                      "Linefeed" "Return" "Backspace")
+     when (funcall matchp prefix name)
+     collect name))
+
+
+(defparameter *type-specifier-arglists*
+  '((and                . (&rest type-specifiers))
+    (array              . (&optional element-type dimension-spec))
+    (base-string        . (&optional size))
+    (bit-vector         . (&optional size))
+    (complex            . (&optional type-specifier))
+    (cons               . (&optional car-typespec cdr-typespec))
+    (double-float       . (&optional lower-limit upper-limit))
+    (eql                . (object))
+    (float              . (&optional lower-limit upper-limit))
+    (function           . (&optional arg-typespec value-typespec))
+    (integer            . (&optional lower-limit upper-limit))
+    (long-float         . (&optional lower-limit upper-limit))
+    (member             . (&rest eql-objects))
+    (mod                . (n))
+    (not                . (type-specifier))
+    (or                 . (&rest type-specifiers))
+    (rational           . (&optional lower-limit upper-limit))
+    (real               . (&optional lower-limit upper-limit))
+    (satisfies          . (predicate-symbol))
+    (short-float        . (&optional lower-limit upper-limit))
+    (signed-byte        . (&optional size))
+    (simple-array       . (&optional element-type dimension-spec))
+    (simple-base-string . (&optional size))
+    (simple-bit-vector  . (&optional size))
+    (simple-string      . (&optional size))
+    (single-float       . (&optional lower-limit upper-limit))
+    (simple-vector      . (&optional size))
+    (string             . (&optional size))
+    (unsigned-byte      . (&optional size))
+    (values             . (&rest typespecs))
+    (vector             . (&optional element-type size))
+    ))

Added: branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,672 @@
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
+
+;;;; SWANK support for CLISP.
+
+;;;; Copyright (C) 2003, 2004 W. Jenkner, V. Sedach
+
+;;;; This program is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU General Public License as
+;;;; published by the Free Software Foundation; either version 2 of
+;;;; the License, or (at your option) any later version.
+
+;;;; This program is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+
+;;;; You should have received a copy of the GNU General Public
+;;;; License along with this program; if not, write to the Free
+;;;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+;;;; MA 02111-1307, USA.
+
+;;; This is work in progress, but it's already usable.  Many things
+;;; are adapted from other swank-*.lisp, in particular from
+;;; swank-allegro (I don't use allegro at all, but it's the shortest
+;;; one and I found Helmut Eller's code there enlightening).
+
+;;; This code will work better with recent versions of CLISP (say, the
+;;; last release or CVS HEAD) while it may not work at all with older
+;;; versions.  It is reasonable to expect it to work on platforms with
+;;; a "SOCKET" package, in particular on GNU/Linux or Unix-like
+;;; systems, but also on Win32.  This backend uses the portable xref
+;;; from the CMU AI repository and metering.lisp from CLOCC [1], which
+;;; are conveniently included in SLIME.
+
+;;; [1] http://cvs.sourceforge.net/viewcvs.py/clocc/clocc/src/tools/metering/
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  ;;(use-package "SOCKET")
+  (use-package "GRAY"))
+
+;;;; if this lisp has the complete CLOS then we use it, otherwise we
+;;;; build up a "fake" swank-mop and then override the methods in the
+;;;; inspector.
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *have-mop*
+    (and (find-package :clos)
+         (eql :external
+              (nth-value 1 (find-symbol (string ':standard-slot-definition)
+                                        :clos))))
+    "True in those CLISP images which have a complete MOP implementation."))
+
+#+#.(cl:if swank-backend::*have-mop* '(cl:and) '(cl:or))
+(progn
+  (import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+  (defun swank-mop:slot-definition-documentation (slot)
+    (clos::slot-definition-documentation slot)))
+
+#-#.(cl:if swank-backend::*have-mop* '(and) '(or))
+(defclass swank-mop:standard-slot-definition ()
+  ()
+  (:documentation
+   "Dummy class created so that swank.lisp will compile and load."))
+
+;; #+#.(cl:if (cl:find-package "LINUX") '(and) '(or))
+;; (progn
+;;   (defmacro with-blocked-signals ((&rest signals) &body body)
+;;     (ext:with-gensyms ("SIGPROCMASK" ret mask)
+;;       `(multiple-value-bind (,ret ,mask)
+;;            (linux:sigprocmask-set-n-save
+;;             ,linux:SIG_BLOCK
+;;             ,(do ((sigset (linux:sigset-empty)
+;;                           (linux:sigset-add sigset (the fixnum (pop signals)))))
+;;                  ((null signals) sigset)))
+;;          (linux:check-res ,ret 'linux:sigprocmask-set-n-save)
+;;          (unwind-protect
+;;               (progn , at body)
+;;            (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
+
+;;   (defimplementation call-without-interrupts (fn)
+;;     (with-blocked-signals (#.linux:SIGINT) (funcall fn))))
+
+;; #+#.(cl:if (cl:find-package "LINUX") '(or) '(and))
+(defimplementation call-without-interrupts (fn)
+  (funcall fn))
+
+(let ((getpid (or (find-symbol "PROCESS-ID" :system)
+                  ;; old name prior to 2005-03-01, clisp <= 2.33.2
+                  (find-symbol "PROGRAM-ID" :system)
+                  #+win32 ; integrated into the above since 2005-02-24
+                  (and (find-package :win32) ; optional modules/win32
+                       (find-symbol "GetCurrentProcessId" :win32)))))
+  (defimplementation getpid () ; a required interface
+    (cond
+      (getpid (funcall getpid))
+      #+win32 ((ext:getenv "PID")) ; where does that come from?
+      (t -1))))
+
+(defimplementation lisp-implementation-type-name ()
+  "clisp")
+
+(defimplementation set-default-directory (directory)
+  (setf (ext:default-directory) directory)
+  (namestring (setf *default-pathname-defaults* (ext:default-directory))))
+
+;;;; TCP Server
+
+(defimplementation create-socket (host port)
+  (declare (ignore host))
+  (socket:socket-server port))
+
+(defimplementation local-port (socket)
+  (socket:socket-server-port socket))
+
+(defimplementation close-socket (socket)
+  (socket:socket-server-close socket))
+
+(defimplementation accept-connection (socket
+                                      &key external-format buffering timeout)
+  (declare (ignore buffering timeout))
+  (socket:socket-accept socket
+                        :buffered nil ;; XXX should be t
+                        :element-type 'character
+                        :external-format external-format))
+
+;;;; Coding systems
+
+(defvar *external-format-to-coding-system*
+  '(((:charset "iso-8859-1" :line-terminator :unix)
+     "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+    ((:charset "iso-8859-1":latin-1)
+     "latin-1" "iso-latin-1" "iso-8859-1")
+    ((:charset "utf-8") "utf-8")
+    ((:charset "utf-8" :line-terminator :unix) "utf-8-unix")
+    ((:charset "euc-jp") "euc-jp")
+    ((:charset "euc-jp" :line-terminator :unix) "euc-jp-unix")
+    ((:charset "us-ascii") "us-ascii")
+    ((:charset "us-ascii" :line-terminator :unix) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (let ((args (car (rassoc-if (lambda (x)
+                                (member coding-system x :test #'equal))
+                              *external-format-to-coding-system*))))
+    (and args (apply #'ext:make-encoding args))))
+
+
+;;;; Swank functions
+
+(defimplementation arglist (fname)
+  (block nil
+    (or (ignore-errors
+          (let ((exp (function-lambda-expression fname)))
+            (and exp (return (second exp)))))
+        (ignore-errors
+          (return (ext:arglist fname)))
+        :not-available)))
+
+(defimplementation macroexpand-all (form)
+  (ext:expand-form form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+  (let ((result ()))
+    (flet ((doc (kind)
+             (or (documentation symbol kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push :variable (when (boundp symbol) (doc 'variable)))
+      (when (fboundp symbol)
+        (maybe-push
+         ;; Report WHEN etc. as macros, even though they may be
+         ;; implemented as special operators.
+         (if (macro-function symbol) :macro
+             (typecase (fdefinition symbol)
+               (generic-function :generic-function)
+               (function         :function)
+               ;; (type-of 'progn) -> ext:special-operator
+               (t                :special-operator)))
+         (doc 'function)))
+      (when (or (get symbol 'system::setf-function) ; e.g. #'(setf elt)
+                (get symbol 'system::setf-expander)); defsetf
+        (maybe-push :setf (doc 'setf)))
+      (when (or (get symbol 'system::type-symbol); cf. clisp/src/describe.lisp
+                (get symbol 'system::defstruct-description)
+                (get symbol 'system::deftype-expander))
+        (maybe-push :type (doc 'type))) ; even for 'structure
+      (when (find-class symbol nil)
+        (maybe-push :class (doc 'type)))
+      ;; Let this code work compiled in images without FFI
+      (let ((types (load-time-value
+                    (and (find-package "FFI")
+                         (symbol-value
+                          (find-symbol "*C-TYPE-TABLE*" "FFI"))))))
+        ;; Use ffi::*c-type-table* so as not to suffer the overhead of
+        ;; (ignore-errors (ffi:parse-c-type symbol)) for 99.9% of symbols
+        ;; which are not FFI type names.
+        (when (and types (nth-value 1 (gethash symbol types)))
+          ;; Maybe use (case (head (ffi:deparse-c-type)))
+          ;; to distinguish struct and union types?
+          (maybe-push :alien-type :not-documented)))
+      result)))
+
+(defimplementation describe-definition (symbol namespace)
+  (ecase namespace
+    (:variable (describe symbol))
+    (:macro (describe (macro-function symbol)))
+    (:function (describe (symbol-function symbol)))
+    (:class (describe (find-class symbol)))))
+
+(defun fspec-pathname (symbol)
+  (let ((path (documentation symbol 'sys::file))
+        lines)
+    (when (consp path)
+      (psetq path (car path)
+             lines (cdr path)))
+    (when (and path
+               (member (pathname-type path)
+                       custom:*compiled-file-types* :test #'equal))
+      (setq path
+            (loop for suffix in custom:*source-file-types*
+               thereis (probe-file (make-pathname :defaults path
+                                                  :type suffix)))))
+    (values path lines)))
+
+(defun fspec-location (fspec)
+  (multiple-value-bind (file lines)
+      (fspec-pathname fspec)
+    (cond (file
+           (multiple-value-bind (truename c) (ignore-errors (truename file))
+             (cond (truename
+                    (make-location (list :file (namestring truename))
+                                   (if (consp lines)
+                                       (list* :line lines)
+                                       (list :function-name (string fspec)))))
+                   (t (list :error (princ-to-string c))))))
+          (t (list :error (format nil "No source information available for: ~S"
+                                  fspec))))))
+
+(defimplementation find-definitions (name)
+  (list (list name (fspec-location name))))
+
+(defun trim-whitespace (string)
+  (string-trim #(#\newline #\space #\tab) string))
+
+(defvar *sldb-backtrace*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (let* (;;(sys::*break-count* (1+ sys::*break-count*))
+         ;;(sys::*driver* debugger-loop-fn)
+         ;;(sys::*fasoutput-stream* nil)
+         (*sldb-backtrace*
+          (nthcdr 3 (member (sys::the-frame) (sldb-backtrace)))))
+    (funcall debugger-loop-fn)))
+
+(defun nth-frame (index)
+  (nth index *sldb-backtrace*))
+
+(defun sldb-backtrace ()
+  "Return a list ((ADDRESS . DESCRIPTION) ...) of frames."
+  (do ((frames '())
+       (last nil frame)
+       (frame (sys::the-frame) (sys::frame-up-1 frame 1))) ; 1 = "all frames"
+      ((eq frame last) (nreverse frames))
+    (unless (boring-frame-p frame)
+      (push frame frames))))
+
+(defun boring-frame-p (frame)
+  (member (frame-type frame) '(stack-value bind-var bind-env)))
+
+(defun frame-to-string (frame)
+  (with-output-to-string (s)
+    (sys::describe-frame s frame)))
+
+(defun frame-type (frame)
+  ;; FIXME: should bind *print-length* etc. to small values.
+  (frame-string-type (frame-to-string frame)))
+
+(defvar *frame-prefixes*
+  '(("frame binding variables" bind-var)
+    ("<1> #<compiled-function" compiled-fun)
+    ("<1> #<system-function" sys-fun)
+    ("<1> #<special-operator" special-op)
+    ("EVAL frame" eval)
+    ("APPLY frame" apply)
+    ("compiled tagbody frame" compiled-tagbody)
+    ("compiled block frame" compiled-block)
+    ("block frame" block)
+    ("nested block frame" block)
+    ("tagbody frame" tagbody)
+    ("nested tagbody frame" tagbody)
+    ("catch frame" catch)
+    ("handler frame" handler)
+    ("unwind-protect frame" unwind-protect)
+    ("driver frame" driver)
+    ("frame binding environments" bind-env)
+    ("CALLBACK frame" callback)
+    ("- " stack-value)
+    ("<1> " fun)
+    ("<2> " 2nd-frame)))
+
+(defun frame-string-type (string)
+  (cadr (assoc-if (lambda (pattern) (is-prefix-p pattern string))
+                  *frame-prefixes*)))
+
+(defimplementation compute-backtrace (start end)
+  (let* ((bt *sldb-backtrace*)
+         (len (length bt)))
+    (subseq bt start (min (or end len) len))))
+
+;;; CLISP's REPL sets up an ABORT restart that kills SWANK.  Here we
+;;; can omit that restart so that users don't select it by mistake.
+(defimplementation compute-sane-restarts (condition)
+  ;; The outermost restart is specified to be the last element of the
+  ;; list, hopefully that's our unwanted ABORT restart.
+  (butlast (compute-restarts condition)))
+
+(defimplementation print-frame (frame stream)
+  (let ((str (frame-to-string frame)))
+    ;; (format stream "~A " (frame-string-type str))
+    (write-string (extract-frame-line str)
+                  stream)))
+
+(defun extract-frame-line (frame-string)
+  (let ((s frame-string))
+    (trim-whitespace
+     (case (frame-string-type s)
+       ((eval special-op)
+        (string-match "EVAL frame .*for form \\(.*\\)" s 1))
+       (apply
+        (string-match "APPLY frame for call \\(.*\\)" s 1))
+       ((compiled-fun sys-fun fun)
+        (extract-function-name s))
+       (t s)))))
+
+(defun extract-function-name (string)
+  (let ((1st (car (split-frame-string string))))
+    (or (string-match (format nil "^<1>[ ~%]*#<[-A-Za-z]* \\(.*\\)>")
+                      1st
+                      1)
+        (string-match (format nil "^<1>[ ~%]*\\(.*\\)") 1st 1)
+        1st)))
+
+(defun split-frame-string (string)
+  (let ((rx (format nil "~%\\(~{~A~^\\|~}\\)"
+                    (mapcar #'car *frame-prefixes*))))
+    (loop for pos = 0 then (1+ (regexp:match-start match))
+          for match = (regexp:match rx string :start pos)
+          if match collect (subseq string pos (regexp:match-start match))
+          else collect (subseq string pos)
+          while match)))
+
+(defun string-match (pattern string n)
+  (let* ((match (nth-value n (regexp:match pattern string))))
+    (if match (regexp:match-string string match))))
+
+(defimplementation format-sldb-condition (condition)
+  (trim-whitespace (princ-to-string condition)))
+
+(defimplementation eval-in-frame (form frame-number)
+  (sys::eval-at (nth-frame frame-number) form))
+
+(defimplementation frame-locals (frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (loop for i below (%frame-count-vars frame)
+          collect (list :name (%frame-var-name frame i)
+                        :value (%frame-var-value frame i)
+                        :id 0))))
+
+(defimplementation frame-var-value (frame var)
+  (%frame-var-value (nth-frame frame) var))
+
+;;; Interpreter-Variablen-Environment has the shape
+;;; NIL or #(v1 val1 ... vn valn NEXT-ENV).
+
+(defun %frame-count-vars (frame)
+  (cond ((sys::eval-frame-p frame)
+         (do ((venv (frame-venv frame) (next-venv venv))
+              (count 0 (+ count (/ (1- (length venv)) 2))))
+             ((not venv) count)))
+        ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+         (length (%parse-stack-values frame)))
+        (t 0)))
+
+(defun %frame-var-name (frame i)
+  (cond ((sys::eval-frame-p frame)
+         (nth-value 0 (venv-ref (frame-venv frame) i)))
+        (t (format nil "~D" i))))
+
+(defun %frame-var-value (frame i)
+  (cond ((sys::eval-frame-p frame)
+         (let ((name (venv-ref (frame-venv frame) i)))
+           (multiple-value-bind (v c) (ignore-errors (sys::eval-at frame name))
+             (if c
+                 (format-sldb-condition c)
+                 v))))
+        ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+         (let ((str (nth i (%parse-stack-values frame))))
+           (trim-whitespace (subseq str 2))))
+        (t (break "Not implemented"))))
+
+(defun frame-venv (frame)
+  (let ((env (sys::eval-at frame '(sys::the-environment))))
+    (svref env 0)))
+
+(defun next-venv (venv) (svref venv (1- (length venv))))
+
+(defun venv-ref (env i)
+  "Reference the Ith binding in ENV.
+Return two values: NAME and VALUE"
+  (let ((idx (* i 2)))
+    (if (< idx (1- (length env)))
+        (values (svref env idx) (svref env (1+ idx)))
+        (venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))
+
+(defun %parse-stack-values (frame)
+  (labels ((next (fp) (sys::frame-down-1 fp 1))
+           (parse (fp accu)
+             (let ((str (frame-to-string fp)))
+               (cond ((is-prefix-p "- " str)
+                      (parse  (next fp) (cons str accu)))
+                     ((is-prefix-p "<1> " str)
+                      ;;(when (eq (frame-type frame) 'compiled-fun)
+                      ;;  (pop accu))
+                      (dolist (str (cdr (split-frame-string str)))
+                        (when (is-prefix-p "- " str)
+                          (push str accu)))
+                      (nreverse accu))
+                     (t (parse (next fp) accu))))))
+    (parse (next frame) '())))
+
+(defun is-prefix-p (pattern string)
+  (not (mismatch pattern string :end2 (min (length pattern)
+                                           (length string)))))
+
+(defimplementation frame-catch-tags (index)
+  (declare (ignore index))
+  nil)
+
+(defimplementation return-from-frame (index form)
+  (sys::return-from-eval-frame (nth-frame index) form))
+
+(defimplementation restart-frame (index)
+  (sys::redo-eval-frame (nth-frame index)))
+
+(defimplementation frame-source-location-for-emacs (index)
+  `(:error
+    ,(format nil "frame-source-location not implemented. (frame: ~A)"
+             (nth-frame index))))
+
+;;;; Profiling
+
+(defimplementation profile (fname)
+  (eval `(mon:monitor ,fname)))         ;monitor is a macro
+
+(defimplementation profiled-functions ()
+  mon:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+  (eval `(mon:unmonitor ,fname)))       ;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+  (mon:unmonitor))
+
+(defimplementation profile-report ()
+  (mon:report-monitoring))
+
+(defimplementation profile-reset ()
+  (mon:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+  (declare (ignore callers-p methods))
+  (mon:monitor-all package))
+
+;;;; Handle compiler conditions (find out location of error etc.)
+
+(defmacro compile-file-frobbing-notes ((&rest args) &body body)
+  "Pass ARGS to COMPILE-FILE, send the compiler notes to
+*STANDARD-INPUT* and frob them in BODY."
+  `(let ((*error-output* (make-string-output-stream))
+         (*compile-verbose* t))
+     (multiple-value-prog1
+      (compile-file , at args)
+      (handler-case
+       (with-input-from-string
+        (*standard-input* (get-output-stream-string *error-output*))
+        , at body)
+       (sys::simple-end-of-file () nil)))))
+
+(defvar *orig-c-warn* (symbol-function 'system::c-warn))
+(defvar *orig-c-style-warn* (symbol-function 'system::c-style-warn))
+(defvar *orig-c-error* (symbol-function 'system::c-error))
+(defvar *orig-c-report-problems* (symbol-function 'system::c-report-problems))
+
+(defmacro dynamic-flet (names-functions &body body)
+  "(dynamic-flet ((NAME FUNCTION) ...) BODY ...)
+Execute BODY with NAME's function slot set to FUNCTION."
+  `(ext:letf* ,(loop for (name function) in names-functions
+                     collect `((symbol-function ',name) ,function))
+    , at body))
+
+(defvar *buffer-name* nil)
+(defvar *buffer-offset*)
+
+(defun compiler-note-location ()
+  "Return the current compiler location."
+  (let ((lineno1 sys::*compile-file-lineno1*)
+        (lineno2 sys::*compile-file-lineno2*)
+        (file sys::*compile-file-truename*))
+    (cond ((and file lineno1 lineno2)
+           (make-location (list ':file (namestring file))
+                          (list ':line lineno1)))
+          (*buffer-name*
+           (make-location (list ':buffer *buffer-name*)
+                          (list ':position *buffer-offset*)))
+          (t
+           (list :error "No error location available")))))
+
+(defun signal-compiler-warning (cstring args severity orig-fn)
+  (signal (make-condition 'compiler-condition
+                          :severity severity
+                          :message (apply #'format nil cstring args)
+                          :location (compiler-note-location)))
+  (apply orig-fn cstring args))
+
+(defun c-warn (cstring &rest args)
+  (signal-compiler-warning cstring args :warning *orig-c-warn*))
+
+(defun c-style-warn (cstring &rest args)
+  (dynamic-flet ((sys::c-warn *orig-c-warn*))
+    (signal-compiler-warning cstring args :style-warning *orig-c-style-warn*)))
+
+(defun c-error (cstring &rest args)
+  (signal-compiler-warning cstring args :error *orig-c-error*))
+
+(defimplementation call-with-compilation-hooks (function)
+  (handler-bind ((warning #'handle-notification-condition))
+    (dynamic-flet ((system::c-warn #'c-warn)
+                   (system::c-style-warn #'c-style-warn)
+                   (system::c-error #'c-error))
+      (funcall function))))
+
+(defun handle-notification-condition (condition)
+  "Handle a condition caused by a compiler warning."
+  (signal (make-condition 'compiler-condition
+                          :original-condition condition
+                          :severity :warning
+                          :message (princ-to-string condition)
+                          :location (compiler-note-location))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (with-compilation-hooks ()
+    (with-compilation-unit ()
+      (let ((fasl-file (compile-file filename
+                                     :external-format external-format)))
+        (when (and load-p fasl-file)
+          (load fasl-file))
+        nil))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-offset* position))
+      (funcall (compile nil (read-from-string
+                             (format nil "(~S () ~A)" 'lambda string)))))))
+
+;;;; Portable XREF from the CMU AI repository.
+
+(setq pxref::*handle-package-forms* '(cl:in-package))
+
+(defmacro defxref (name function)
+  `(defimplementation ,name (name)
+    (xref-results (,function name))))
+
+(defxref who-calls      pxref:list-callers)
+(defxref who-references pxref:list-readers)
+(defxref who-binds      pxref:list-setters)
+(defxref who-sets       pxref:list-setters)
+(defxref list-callers   pxref:list-callers)
+(defxref list-callees   pxref:list-callees)
+
+(defun xref-results (symbols)
+  (let ((xrefs '()))
+    (dolist (symbol symbols)
+      (push (list symbol (fspec-location symbol)) xrefs))
+    xrefs))
+
+(when (find-package :swank-loader)
+  (setf (symbol-function (intern "USER-INIT-FILE" :swank-loader))
+        (lambda ()
+          (let ((home (user-homedir-pathname)))
+            (and (ext:probe-directory home)
+                 (probe-file (format nil "~A/.swank.lisp"
+                                     (namestring (truename home)))))))))
+
+;;; Don't set *debugger-hook* to nil on break.
+(ext:without-package-lock ()
+ (defun break (&optional (format-string "Break") &rest args)
+   (if (not sys::*use-clcs*)
+       (progn
+         (terpri *error-output*)
+         (apply #'format *error-output*
+                (concatenate 'string "*** - " format-string)
+                args)
+         (funcall ext:*break-driver* t))
+       (let ((condition
+              (make-condition 'simple-condition
+                              :format-control format-string
+                              :format-arguments args))
+             ;;(*debugger-hook* nil)
+             ;; Issue 91
+             )
+         (ext:with-restarts
+             ((continue
+               :report (lambda (stream)
+                         (format stream (sys::text "Return from ~S loop")
+                                 'break))
+               ()))
+           (with-condition-restarts condition (list (find-restart 'continue))
+                                    (invoke-debugger condition)))))
+   nil))
+
+;;;; Inspecting
+
+(defclass clisp-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector () (make-instance 'clisp-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (let* ((*print-array* nil) (*print-pretty* t)
+         (*print-circle* t) (*print-escape* t)
+         (*print-lines* custom:*inspect-print-lines*)
+         (*print-level* custom:*inspect-print-level*)
+         (*print-length* custom:*inspect-print-length*)
+         (sys::*inspect-all* (make-array 10 :fill-pointer 0 :adjustable t))
+         (tmp-pack (make-package (gensym "INSPECT-TMP-PACKAGE-")))
+         (*package* tmp-pack)
+         (sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
+    (let ((inspection (sys::inspect-backend o)))
+      (values (format nil "~S~% ~A~{~%~A~}" o
+                      (sys::insp-title inspection)
+                      (sys::insp-blurb inspection))
+              (loop with count = (sys::insp-num-slots inspection)
+                    for i below count
+                    append (multiple-value-bind (value name)
+                               (funcall (sys::insp-nth-slot inspection)
+                                        i)
+                             `((:value ,name) " = " (:value ,value)
+                               (:newline))))))))
+
+(defimplementation quit-lisp ()
+  #+lisp=cl (ext:quit)
+  #-lisp=cl (lisp:quit))
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+  (apply #'make-hash-table :weak :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+  (apply #'make-hash-table :weak :value args))
+
+;;; Local Variables:
+;;; eval: (put 'compile-file-frobbing-notes 'lisp-indent-function 1)
+;;; eval: (put 'dynamic-flet 'common-lisp-indent-function 1)
+;;; End:

Added: branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2255 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
+;;;
+;;; License: Public Domain
+;;;
+;;;; Introduction
+;;;
+;;; This is the CMUCL implementation of the `swank-backend' package.
+
+(in-package :swank-backend)
+
+(import-swank-mop-symbols :pcl '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+  (documentation slot t))
+
+;;;; "Hot fixes"
+;;;
+;;; Here are necessary bugfixes to the oldest supported version of
+;;; CMUCL (currently 18e). Any fixes placed here should also be
+;;; submitted to the `cmucl-imp' mailing list and confirmed as
+;;; good. When a new release is made that includes the fixes we should
+;;; promptly delete them from here. It is enough to be compatible with
+;;; the latest release.
+
+(in-package :lisp)
+
+;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new
+;;; definition works better.
+
+#-cmu19
+(progn
+  (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+    (when s
+      (setf (symbol-value s) nil)))
+
+  (defun read-into-simple-string (s stream start end)
+    (declare (type simple-string s))
+    (declare (type stream stream))
+    (declare (type index start end))
+    (unless (subtypep (stream-element-type stream) 'character)
+      (error 'type-error
+             :datum (read-char stream nil #\Null)
+             :expected-type (stream-element-type stream)
+             :format-control "Trying to read characters from a binary stream."))
+    ;; Let's go as low level as it seems reasonable.
+    (let* ((numbytes (- end start))
+           (total-bytes 0))
+      ;; read-n-bytes may return fewer bytes than requested, so we need
+      ;; to keep trying.
+      (loop while (plusp numbytes) do
+            (let ((bytes-read (system:read-n-bytes stream s start numbytes nil)))
+              (when (zerop bytes-read)
+                (return-from read-into-simple-string total-bytes))
+              (incf total-bytes bytes-read)
+              (incf start bytes-read)
+              (decf numbytes bytes-read)))
+      total-bytes))
+
+  (let ((s (find-symbol (string :*enable-package-locked-errors*) :lisp)))
+    (when s
+      (setf (symbol-value s) t)))
+
+  )
+
+(in-package :swank-backend)
+
+
+;;;; TCP server
+;;;
+;;; In CMUCL we support all communication styles. By default we use
+;;; `:SIGIO' because it is the most responsive, but it's somewhat
+;;; dangerous: CMUCL is not in general "signal safe", and you don't
+;;; know for sure what you'll be interrupting. Both `:FD-HANDLER' and
+;;; `:SPAWN' are reasonable alternatives.
+
+(defimplementation preferred-communication-style ()
+  :sigio)
+
+#-(or darwin mips)
+(defimplementation create-socket (host port)
+  (let* ((addr (resolve-hostname host))
+         (addr (if (not (find-symbol "SOCKET-ERROR" :ext))
+                   (ext:htonl addr)
+                   addr)))
+    (ext:create-inet-listener port :stream :reuse-address t :host addr)))
+
+;; There seems to be a bug in create-inet-listener on Mac/OSX and Irix.
+#+(or darwin mips)
+(defimplementation create-socket (host port)
+  (declare (ignore host))
+  (ext:create-inet-listener port :stream :reuse-address t))
+
+(defimplementation local-port (socket)
+  (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+  (let ((fd (socket-fd socket)))
+    (sys:invalidate-descriptor fd) 
+    (ext:close-socket fd)))
+
+(defimplementation accept-connection (socket &key
+                                      external-format buffering timeout)
+  (declare (ignore timeout external-format))
+  (let ((buffering (or buffering :full)))
+    (make-socket-io-stream (ext:accept-tcp-connection socket) buffering)))
+
+;;;;; Sockets
+
+(defun socket-fd (socket)
+  "Return the filedescriptor for the socket represented by SOCKET."
+  (etypecase socket
+    (fixnum socket)
+    (sys:fd-stream (sys:fd-stream-fd socket))))
+
+(defun resolve-hostname (hostname)
+  "Return the IP address of HOSTNAME as an integer (in host byte-order)."
+  (let ((hostent (ext:lookup-host-entry hostname)))
+    (car (ext:host-entry-addr-list hostent))))
+
+(defun make-socket-io-stream (fd buffering)
+  "Create a new input/output fd-stream for FD."
+  (sys:make-fd-stream fd :input t :output t :element-type 'base-char
+                      :buffering buffering))
+
+;;;;; Signal-driven I/O
+
+(defvar *sigio-handlers* '()
+  "List of (key . function) pairs.
+All functions are called on SIGIO, and the key is used for removing
+specific functions.")
+
+(defun set-sigio-handler ()
+  (sys:enable-interrupt :sigio (lambda (signal code scp)
+                                 (sigio-handler signal code scp))))
+
+(defun sigio-handler (signal code scp)
+  (declare (ignore signal code scp))
+  (mapc #'funcall (mapcar #'cdr *sigio-handlers*)))
+
+(defun fcntl (fd command arg)
+  "fcntl(2) - manipulate a file descriptor."
+  (multiple-value-bind (ok error) (unix:unix-fcntl fd command arg)
+    (unless ok (error "fcntl: ~A" (unix:get-unix-error-msg error)))))
+
+(defimplementation add-sigio-handler (socket fn)
+  (set-sigio-handler)
+  (let ((fd (socket-fd socket)))
+    (fcntl fd unix:f-setown (unix:unix-getpid))
+    (fcntl fd unix:f-setfl unix:fasync)
+    (push (cons fd fn) *sigio-handlers*)))
+
+(defimplementation remove-sigio-handlers (socket)
+  (let ((fd (socket-fd socket)))
+    (setf *sigio-handlers* (remove fd *sigio-handlers* :key #'car))
+    (sys:invalidate-descriptor fd)))
+
+;;;;; SERVE-EVENT
+
+(defimplementation add-fd-handler (socket fn)
+  (let ((fd (socket-fd socket)))
+    (sys:add-fd-handler fd :input (lambda (_) _ (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+  (sys:invalidate-descriptor (socket-fd socket)))
+
+
+;;;; Stream handling
+;;; XXX: How come we don't use Gray streams in CMUCL too? -luke (15/May/2004)
+
+(defimplementation make-fn-streams (input-fn output-fn)
+  (let* ((output (make-slime-output-stream output-fn))
+         (input  (make-slime-input-stream input-fn output)))
+    (values input output)))
+
+(defstruct (slime-output-stream
+             (:include lisp::lisp-stream
+                       (lisp::misc #'sos/misc)
+                       (lisp::out #'sos/out)
+                       (lisp::sout #'sos/sout))
+             (:conc-name sos.)
+             (:print-function %print-slime-output-stream)
+             (:constructor make-slime-output-stream (output-fn)))
+  (output-fn nil :type function)
+  (buffer (make-string 8000) :type string)
+  (index 0 :type kernel:index)
+  (column 0 :type kernel:index)
+  (last-flush-time (get-internal-real-time) :type unsigned-byte))
+
+(defun %print-slime-output-stream (s stream d)
+  (declare (ignore d))
+  (print-unreadable-object (s stream :type t :identity t)))
+
+(defun sos/out (stream char)
+  (system:without-interrupts 
+    (let ((buffer (sos.buffer stream))
+          (index (sos.index stream)))
+      (setf (schar buffer index) char)
+      (setf (sos.index stream) (1+ index))
+      (incf (sos.column stream))
+      (when (char= #\newline char)
+        (setf (sos.column stream) 0)
+        (force-output stream))
+      (when (= index (1- (length buffer)))
+        (finish-output stream)))
+    char))
+
+(defun sos/sout (stream string start end)
+  (system:without-interrupts 
+    (loop for i from start below end 
+          do (sos/out stream (aref string i)))))
+
+(defun log-stream-op (stream operation)
+  stream operation
+  #+(or)
+  (progn 
+    (format sys:*tty* "~S @ ~D ~A~%" operation 
+            (sos.index stream)
+            (/ (- (get-internal-real-time) (sos.last-flush-time stream))
+             (coerce internal-time-units-per-second 'double-float)))
+    (finish-output sys:*tty*)))
+  
+(defun sos/misc (stream operation &optional arg1 arg2)
+  (declare (ignore arg1 arg2))
+  (case operation
+    (:finish-output
+     (log-stream-op stream operation)
+     (system:without-interrupts 
+       (let ((end (sos.index stream)))
+         (unless (zerop end)
+           (let ((s (subseq (sos.buffer stream) 0 end)))
+             (setf (sos.index stream) 0)
+             (funcall (sos.output-fn stream) s))
+           (setf (sos.last-flush-time stream) (get-internal-real-time)))))
+     nil)
+    (:force-output
+     (log-stream-op stream operation)
+     (sos/misc-force-output stream)
+     nil)
+    (:charpos (sos.column stream))
+    (:line-length 75)
+    (:file-position nil)
+    (:element-type 'base-char)
+    (:get-command nil)
+    (:close nil)
+    (t (format *terminal-io* "~&~Astream: ~S~%" stream operation))))
+
+(defun sos/misc-force-output (stream)
+  (system:without-interrupts 
+    (unless (or (zerop (sos.index stream))
+                (loop with buffer = (sos.buffer stream)
+                      for i from 0 below (sos.index stream)
+                      always (char= (aref buffer i) #\newline)))
+      (let ((last (sos.last-flush-time stream))
+            (now (get-internal-real-time)))
+        (when (> (/ (- now last)
+                    (coerce internal-time-units-per-second 'double-float))
+                 0.1)
+          (finish-output stream))))))
+
+(defstruct (slime-input-stream
+             (:include string-stream
+                       (lisp::in #'sis/in)
+                       (lisp::misc #'sis/misc))
+             (:conc-name sis.)
+             (:print-function %print-slime-output-stream)
+             (:constructor make-slime-input-stream (input-fn sos)))
+  (input-fn nil :type function)
+  ;; We know our sibling output stream, so that we can force it before
+  ;; requesting input.
+  (sos      nil :type slime-output-stream)
+  (buffer   ""  :type string)
+  (index    0   :type kernel:index))
+
+(defun sis/in (stream eof-errorp eof-value)
+  (finish-output (sis.sos stream))
+  (let ((index (sis.index stream))
+	(buffer (sis.buffer stream)))
+    (when (= index (length buffer))
+      (let ((string (funcall (sis.input-fn stream))))
+        (cond ((zerop (length string))
+               (return-from sis/in
+                 (if eof-errorp
+                     (error (make-condition 'end-of-file :stream stream))
+                     eof-value)))
+              (t
+               (setf buffer string)
+               (setf (sis.buffer stream) buffer)
+               (setf index 0)))))
+    (prog1 (aref buffer index)
+      (setf (sis.index stream) (1+ index)))))
+
+(defun sis/misc (stream operation &optional arg1 arg2)
+  (declare (ignore arg2))
+  (ecase operation
+    (:file-position nil)
+    (:file-length nil)
+    (:unread (setf (aref (sis.buffer stream) 
+			 (decf (sis.index stream)))
+		   arg1))
+    (:clear-input 
+     (setf (sis.index stream) 0
+			(sis.buffer stream) ""))
+    (:listen (< (sis.index stream) (length (sis.buffer stream))))
+    (:charpos nil)
+    (:line-length nil)
+    (:get-command nil)
+    (:element-type 'base-char)
+    (:close nil)
+    (:interactive-p t)))
+
+
+;;;; Compilation Commands
+
+(defvar *previous-compiler-condition* nil
+  "Used to detect duplicates.")
+
+(defvar *previous-context* nil
+  "Previous compiler error context.")
+
+(defvar *buffer-name* nil
+  "The name of the Emacs buffer we are compiling from.
+NIL if we aren't compiling from a buffer.")
+
+(defvar *buffer-start-position* nil)
+(defvar *buffer-substring* nil)
+
+(defimplementation call-with-compilation-hooks (function)
+  (let ((*previous-compiler-condition* nil)
+        (*previous-context* nil)
+        (*print-readably* nil))
+    (handler-bind ((c::compiler-error #'handle-notification-condition)
+                   (c::style-warning  #'handle-notification-condition)
+                   (c::warning        #'handle-notification-condition))
+      (funcall function))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (declare (ignore external-format))
+  (clear-xref-info filename)
+  (with-compilation-hooks ()
+    (let ((*buffer-name* nil)
+          (ext:*ignore-extra-close-parentheses* nil))
+      (multiple-value-bind (output-file warnings-p failure-p)
+          (compile-file filename)
+        (unless failure-p
+          ;; Cache the latest source file for definition-finding.
+          (source-cache-get filename (file-write-date filename))
+          (when load-p (load output-file)))
+        (values output-file warnings-p failure-p)))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-start-position* position)
+          (*buffer-substring* string))
+      (with-input-from-string (stream string)
+        (ext:compile-from-stream 
+         stream 
+         :source-info `(:emacs-buffer ,buffer 
+                        :emacs-buffer-offset ,position
+                        :emacs-buffer-string ,string))))))
+
+
+;;;;; Trapping notes
+;;;
+;;; We intercept conditions from the compiler and resignal them as
+;;; `SWANK:COMPILER-CONDITION's.
+
+(defun handle-notification-condition (condition)
+  "Handle a condition caused by a compiler warning."
+  (unless (eq condition *previous-compiler-condition*)
+    (let ((context (c::find-error-context nil)))
+      (setq *previous-compiler-condition* condition)
+      (setq *previous-context* context)
+      (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+  (signal (make-condition
+           'compiler-condition
+           :original-condition condition
+           :severity (severity-for-emacs condition)
+           :short-message (brief-compiler-message-for-emacs condition)
+           :message (long-compiler-message-for-emacs condition context)
+           :location (if (read-error-p condition)
+                         (read-error-location condition)
+                         (compiler-note-location context)))))
+
+(defun severity-for-emacs (condition)
+  "Return the severity of CONDITION."
+  (etypecase condition
+    ((satisfies read-error-p) :read-error)
+    (c::compiler-error :error)
+    (c::style-warning :note)
+    (c::warning :warning)))
+
+(defun read-error-p (condition)
+  (eq (type-of condition) 'c::compiler-read-error))
+
+(defun brief-compiler-message-for-emacs (condition)
+  "Briefly describe a compiler error for Emacs.
+When Emacs presents the message it already has the source popped up
+and the source form highlighted. This makes much of the information in
+the error-context redundant."
+  (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+  "Describe a compiler error for Emacs including context information."
+  (declare (type (or c::compiler-error-context null) error-context))
+  (multiple-value-bind (enclosing source)
+      (if error-context
+          (values (c::compiler-error-context-enclosing-source error-context)
+                  (c::compiler-error-context-source error-context)))
+    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
+            enclosing source condition)))
+
+(defun read-error-location (condition)
+  (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+         (file (c::file-info-name finfo))
+         (pos (c::compiler-read-error-position condition)))
+    (cond ((and (eq file :stream) *buffer-name*)
+           (make-location (list :buffer *buffer-name*)
+                          (list :position (+ *buffer-start-position* pos))))
+          ((and (pathnamep file) (not *buffer-name*))
+           (make-location (list :file (unix-truename file))
+                          (list :position (1+ pos))))
+          (t (break)))))
+
+(defun compiler-note-location (context)
+  "Derive the location of a complier message from its context.
+Return a `location' record, or (:error REASON) on failure."
+  (if (null context)
+      (note-error-location)
+      (let ((file (c::compiler-error-context-file-name context))
+            (source (c::compiler-error-context-original-source context))
+            (path
+             (reverse (c::compiler-error-context-original-source-path context))))
+        (or (locate-compiler-note file source path)
+            (note-error-location)))))
+
+(defun note-error-location ()
+  "Pseudo-location for notes that can't be located."
+  (list :error "No error location available."))
+
+(defun locate-compiler-note (file source source-path)
+  (cond ((and (eq file :stream) *buffer-name*)
+         ;; Compiling from a buffer
+         (let ((position (+ *buffer-start-position*
+                            (source-path-string-position
+                             source-path *buffer-substring*))))
+           (make-location (list :buffer *buffer-name*)
+                          (list :position position))))
+        ((and (pathnamep file) (null *buffer-name*))
+         ;; Compiling from a file
+         (make-location (list :file (unix-truename file))
+                        (list :position
+                              (1+ (source-path-file-position
+                                   source-path file)))))
+        ((and (eq file :lisp) (stringp source))
+         ;; No location known, but we have the source form.
+         ;; XXX How is this case triggered?  -luke (16/May/2004) 
+         ;; This can happen if the compiler needs to expand a macro
+         ;; but the macro-expander is not yet compiled.  Calling the
+         ;; (interpreted) macro-expander triggers IR1 conversion of
+         ;; the lambda expression for the expander and invokes the
+         ;; compiler recursively.
+         (make-location (list :source-form source)
+                        (list :position 1)))))
+
+(defun unix-truename (pathname)
+  (ext:unix-namestring (truename pathname)))
+
+
+;;;; XREF
+;;;
+;;; Cross-reference support is based on the standard CMUCL `XREF'
+;;; package. This package has some caveats: XREF information is
+;;; recorded during compilation and not preserved in fasl files, and
+;;; XREF recording is disabled by default. Redefining functions can
+;;; also cause duplicate references to accumulate, but
+;;; `swank-compile-file' will automatically clear out any old records
+;;; from the same filename.
+;;;
+;;; To enable XREF recording, set `c:*record-xref-info*' to true. To
+;;; clear out the XREF database call `xref:init-xref-database'.
+
+(defmacro defxref (name function)
+  `(defimplementation ,name (name)
+    (xref-results (,function name))))
+
+(defxref who-calls      xref:who-calls)
+(defxref who-references xref:who-references)
+(defxref who-binds      xref:who-binds)
+(defxref who-sets       xref:who-sets)
+
+;;; More types of XREF information were added since 18e:
+;;;
+#+cmu19
+(progn
+  (defxref who-macroexpands xref:who-macroexpands)
+  ;; XXX
+  (defimplementation who-specializes (symbol)
+    (let* ((methods (xref::who-specializes (find-class symbol)))
+           (locations (mapcar #'method-location methods)))
+      (mapcar #'list methods locations))))
+
+(defun xref-results (contexts)
+  (mapcar (lambda (xref)
+            (list (xref:xref-context-name xref)
+                  (resolve-xref-location xref)))
+          contexts))
+
+(defun resolve-xref-location (xref)
+  (let ((name (xref:xref-context-name xref))
+        (file (xref:xref-context-file xref))
+        (source-path (xref:xref-context-source-path xref)))
+    (cond ((and file source-path)
+           (let ((position (source-path-file-position source-path file)))
+             (make-location (list :file (unix-truename file))
+                            (list :position (1+ position)))))
+          (file
+           (make-location (list :file (unix-truename file))
+                          (list :function-name (string name))))
+          (t
+           `(:error ,(format nil "Unknown source location: ~S ~S ~S " 
+                             name file source-path))))))
+
+(defun clear-xref-info (namestring)
+  "Clear XREF notes pertaining to NAMESTRING.
+This is a workaround for a CMUCL bug: XREF records are cumulative."
+  (when c:*record-xref-info*
+    (let ((filename (truename namestring)))
+      (dolist (db (list xref::*who-calls*
+                        #+cmu19 xref::*who-is-called*
+                        #+cmu19 xref::*who-macroexpands*
+                        xref::*who-references*
+                        xref::*who-binds*
+                        xref::*who-sets*))
+        (maphash (lambda (target contexts)
+                   ;; XXX update during traversal?  
+                   (setf (gethash target db)
+                         (delete filename contexts 
+                                 :key #'xref:xref-context-file
+                                 :test #'equalp)))
+                 db)))))
+
+
+;;;; Find callers and callees
+;;;
+;;; Find callers and callees by looking at the constant pool of
+;;; compiled code objects.  We assume every fdefn object in the
+;;; constant pool corresponds to a call to that function.  A better
+;;; strategy would be to use the disassembler to find actual
+;;; call-sites.
+
+(declaim (inline map-code-constants))
+(defun map-code-constants (code fn)
+  "Call FN for each constant in CODE's constant pool."
+  (check-type code kernel:code-component)
+  (loop for i from vm:code-constants-offset below (kernel:get-header-data code)
+	do (funcall fn (kernel:code-header-ref code i))))
+
+(defun function-callees (function)
+  "Return FUNCTION's callees as a list of functions."
+  (let ((callees '()))
+    (map-code-constants 
+     (vm::find-code-object function)
+     (lambda (obj)
+       (when (kernel:fdefn-p obj)
+	 (push (kernel:fdefn-function obj) callees))))
+    callees))
+
+(declaim (ext:maybe-inline map-allocated-code-components))
+(defun map-allocated-code-components (spaces fn)
+  "Call FN for each allocated code component in one of SPACES.  FN
+receives the object as argument.  SPACES should be a list of the
+symbols :dynamic, :static, or :read-only."
+  (dolist (space spaces)
+    (declare (inline vm::map-allocated-objects)
+             (optimize (ext:inhibit-warnings 3)))
+    (vm::map-allocated-objects
+     (lambda (obj header size)
+       (declare (type fixnum size) (ignore size))
+       (when (= vm:code-header-type header)
+	 (funcall fn obj)))
+     space)))
+
+(declaim (ext:maybe-inline map-caller-code-components))
+(defun map-caller-code-components (function spaces fn)
+  "Call FN for each code component with a fdefn for FUNCTION in its
+constant pool."
+  (let ((function (coerce function 'function)))
+    (declare (inline map-allocated-code-components))
+    (map-allocated-code-components
+     spaces 
+     (lambda (obj)
+       (map-code-constants 
+	obj 
+	(lambda (constant)
+	  (when (and (kernel:fdefn-p constant)
+		     (eq (kernel:fdefn-function constant)
+			 function))
+	    (funcall fn obj))))))))
+
+(defun function-callers (function &optional (spaces '(:read-only :static 
+						      :dynamic)))
+  "Return FUNCTION's callers.  The result is a list of code-objects."
+  (let ((referrers '()))
+    (declare (inline map-caller-code-components))
+    ;;(ext:gc :full t)
+    (map-caller-code-components function spaces 
+                                (lambda (code) (push code referrers)))
+    referrers))
+
+(defun debug-info-definitions (debug-info)
+  "Return the defintions for a debug-info.  This should only be used
+for code-object without entry points, i.e., byte compiled
+code (are theree others?)"
+  ;; This mess has only been tested with #'ext::skip-whitespace, a
+  ;; byte-compiled caller of #'read-char .
+  (check-type debug-info (and (not c::compiled-debug-info) c::debug-info))
+  (let ((name (c::debug-info-name debug-info))
+        (source (c::debug-info-source debug-info)))
+    (destructuring-bind (first) source 
+      (ecase (c::debug-source-from first)
+        (:file 
+         (list (list name
+                     (make-location 
+                      (list :file (unix-truename (c::debug-source-name first)))
+                      (list :function-name (string name))))))))))
+
+(defun code-component-entry-points (code)
+  "Return a list ((NAME LOCATION) ...) of function definitons for
+the code omponent CODE."
+  (let ((names '()))
+    (do ((f (kernel:%code-entry-points code) (kernel::%function-next f)))
+        ((not f))
+      (let ((name (kernel:%function-name f)))
+        (when (ext:valid-function-name-p name)
+          (push (list name (function-location f)) names))))
+    names))
+
+(defimplementation list-callers (symbol)
+  "Return a list ((NAME LOCATION) ...) of callers."
+  (let ((components (function-callers symbol))
+        (xrefs '()))
+    (dolist (code components)
+      (let* ((entry (kernel:%code-entry-points code))
+             (defs (if entry
+                       (code-component-entry-points code)
+                       ;; byte compiled stuff
+                       (debug-info-definitions 
+                        (kernel:%code-debug-info code)))))
+        (setq xrefs (nconc defs xrefs))))
+    xrefs))
+
+(defimplementation list-callees (symbol)
+  (let ((fns (function-callees symbol)))
+    (mapcar (lambda (fn)
+              (list (kernel:%function-name fn)
+                    (function-location fn)))
+            fns)))
+
+
+;;;; Resolving source locations
+;;;
+;;; Our mission here is to "resolve" references to code locations into
+;;; actual file/buffer names and character positions. The references
+;;; we work from come out of the compiler's statically-generated debug
+;;; information, such as `code-location''s and `debug-source''s. For
+;;; more details, see the "Debugger Programmer's Interface" section of
+;;; the CMUCL manual.
+;;;
+;;; The first step is usually to find the corresponding "source-path"
+;;; for the location. Once we have the source-path we can pull up the
+;;; source file and `READ' our way through to the right position. The
+;;; main source-code groveling work is done in
+;;; `swank-source-path-parser.lisp'.
+
+(defvar *debug-definition-finding* nil
+  "When true don't handle errors while looking for definitions.
+This is useful when debugging the definition-finding code.")
+
+(defvar *source-snippet-size* 256
+  "Maximum number of characters in a snippet of source code.
+Snippets at the beginning of definitions are used to tell Emacs what
+the definitions looks like, so that it can accurately find them by
+text search.")
+
+(defmacro safe-definition-finding (&body body)
+  "Execute BODY and return the source-location it returns.
+If an error occurs and `*debug-definition-finding*' is false, then
+return an error pseudo-location.
+
+The second return value is NIL if no error occurs, otherwise it is the
+condition object."
+  `(flet ((body () , at body))
+    (if *debug-definition-finding*
+        (body)
+        (handler-case (values (progn , at body) nil)
+          (error (c) (values `(:error ,(trim-whitespace (princ-to-string c)))
+                             c))))))
+
+(defun trim-whitespace (string)
+  (string-trim #(#\newline #\space #\tab) string))
+
+(defun code-location-source-location (code-location)
+  "Safe wrapper around `code-location-from-source-location'."
+  (safe-definition-finding
+   (source-location-from-code-location code-location)))
+
+(defun source-location-from-code-location (code-location)
+  "Return the source location for CODE-LOCATION."
+  (let ((debug-fun (di:code-location-debug-function code-location)))
+    (when (di::bogus-debug-function-p debug-fun)
+      ;; Those lousy cheapskates! They've put in a bogus debug source
+      ;; because the code was compiled at a low debug setting.
+      (error "Bogus debug function: ~A" debug-fun)))
+  (let* ((debug-source (di:code-location-debug-source code-location))
+         (from (di:debug-source-from debug-source))
+         (name (di:debug-source-name debug-source)))
+    (ecase from
+      (:file 
+       (location-in-file name code-location debug-source))
+      (:stream
+       (location-in-stream code-location debug-source))
+      (:lisp
+       ;; The location comes from a form passed to `compile'.
+       ;; The best we can do is return the form itself for printing.
+       (make-location
+        (list :source-form (with-output-to-string (*standard-output*)
+                             (debug::print-code-location-source-form 
+                              code-location 100 t)))
+        (list :position 1))))))
+
+(defun location-in-file (filename code-location debug-source)
+  "Resolve the source location for CODE-LOCATION in FILENAME."
+  (let* ((code-date (di:debug-source-created debug-source))
+         (source-code (get-source-code filename code-date)))
+    (with-input-from-string (s source-code)
+      (make-location (list :file (unix-truename filename))
+                     (list :position (1+ (code-location-stream-position
+                                          code-location s)))
+                     `(:snippet ,(read-snippet s))))))
+
+(defun location-in-stream (code-location debug-source)
+  "Resolve the source location for a CODE-LOCATION from a stream.
+This only succeeds if the code was compiled from an Emacs buffer."
+  (unless (debug-source-info-from-emacs-buffer-p debug-source)
+    (error "The code is compiled from a non-SLIME stream."))
+  (let* ((info (c::debug-source-info debug-source))
+         (string (getf info :emacs-buffer-string))
+         (position (code-location-string-offset 
+                    code-location
+                    string)))
+    (make-location
+     (list :buffer (getf info :emacs-buffer))
+     (list :position (+ (getf info :emacs-buffer-offset) position))
+     (list :snippet (with-input-from-string (s string)
+                      (file-position s position)
+                      (read-snippet s))))))
+
+;;;;; Function-name locations
+;;;
+(defun debug-info-function-name-location (debug-info)
+  "Return a function-name source-location for DEBUG-INFO.
+Function-name source-locations are a fallback for when precise
+positions aren't available."
+  (with-struct (c::debug-info- (fname name) source) debug-info
+    (with-struct (c::debug-source- info from name) (car source)
+      (ecase from
+        (:file 
+         (make-location (list :file (namestring (truename name)))
+                        (list :function-name (string fname))))
+        (:stream
+         (assert (debug-source-info-from-emacs-buffer-p (car source)))
+         (make-location (list :buffer (getf info :emacs-buffer))
+                        (list :function-name (string fname))))
+        (:lisp
+         (make-location (list :source-form (princ-to-string (aref name 0)))
+                        (list :position 1)))))))
+
+(defun debug-source-info-from-emacs-buffer-p (debug-source)
+  "Does the `info' slot of DEBUG-SOURCE contain an Emacs buffer location?
+This is true for functions that were compiled directly from buffers."
+  (info-from-emacs-buffer-p (c::debug-source-info debug-source)))
+
+(defun info-from-emacs-buffer-p (info)
+  (and info 
+       (consp info)
+       (eq :emacs-buffer (car info))))
+
+
+;;;;; Groveling source-code for positions
+
+(defun code-location-stream-position (code-location stream)
+  "Return the byte offset of CODE-LOCATION in STREAM.  Extract the
+toplevel-form-number and form-number from CODE-LOCATION and use that
+to find the position of the corresponding form.
+
+Finish with STREAM positioned at the start of the code location."
+  (let* ((location (debug::maybe-block-start-location code-location))
+	 (tlf-offset (di:code-location-top-level-form-offset location))
+	 (form-number (di:code-location-form-number location)))
+    (let ((pos (form-number-stream-position tlf-offset form-number stream)))
+      (file-position stream pos)
+      pos)))
+
+(defun form-number-stream-position (tlf-number form-number stream)
+  "Return the starting character position of a form in STREAM.
+TLF-NUMBER is the top-level-form number.
+FORM-NUMBER is an index into a source-path table for the TLF."
+  (multiple-value-bind (tlf position-map) (read-source-form tlf-number stream)
+    (let* ((path-table (di:form-number-translations tlf 0))
+           (source-path
+            (if (<= (length path-table) form-number) ; source out of sync?
+                (list 0)                ; should probably signal a condition
+                (reverse (cdr (aref path-table form-number))))))
+      (source-path-source-position source-path tlf position-map))))
+  
+(defun code-location-string-offset (code-location string)
+  "Return the byte offset of CODE-LOCATION in STRING.
+See CODE-LOCATION-STREAM-POSITION."
+  (with-input-from-string (s string)
+    (code-location-stream-position code-location s)))
+
+
+;;;; Finding definitions
+
+;;; There are a great many different types of definition for us to
+;;; find. We search for definitions of every kind and return them in a
+;;; list.
+
+(defimplementation find-definitions (name)
+  (append (function-definitions name)
+          (setf-definitions name)
+          (variable-definitions name)
+          (class-definitions name)
+          (type-definitions name)
+          (compiler-macro-definitions name)
+          (source-transform-definitions name)
+          (function-info-definitions name)
+          (ir1-translator-definitions name)))
+
+;;;;; Functions, macros, generic functions, methods
+;;;
+;;; We make extensive use of the compile-time debug information that
+;;; CMUCL records, in particular "debug functions" and "code
+;;; locations." Refer to the "Debugger Programmer's Interface" section
+;;; of the CMUCL manual for more details.
+
+(defun function-definitions (name)
+  "Return definitions for NAME in the \"function namespace\", i.e.,
+regular functions, generic functions, methods and macros.
+NAME can any valid function name (e.g, (setf car))."
+  (let ((macro?    (and (symbolp name) (macro-function name)))
+        (special?  (and (symbolp name) (special-operator-p name)))
+        (function? (and (ext:valid-function-name-p name)
+                        (ext:info :function :definition name)
+                        (if (symbolp name) (fboundp name) t))))
+    (cond (macro? 
+           (list `((defmacro ,name)
+                   ,(function-location (macro-function name)))))
+          (special?
+           (list `((:special-operator ,name) 
+                   (:error ,(format nil "Special operator: ~S" name)))))
+          (function?
+           (let ((function (fdefinition name)))
+             (if (genericp function)
+                 (generic-function-definitions name function)
+                 (list (list `(function ,name)
+                             (function-location function)))))))))
+
+;;;;;; Ordinary (non-generic/macro/special) functions
+;;;
+;;; First we test if FUNCTION is a closure created by defstruct, and
+;;; if so extract the defstruct-description (`dd') from the closure
+;;; and find the constructor for the struct.  Defstruct creates a
+;;; defun for the default constructor and we use that as an
+;;; approximation to the source location of the defstruct.
+;;;
+;;; For an ordinary function we return the source location of the
+;;; first code-location we find.
+;;;
+(defun function-location (function)
+  "Return the source location for FUNCTION."
+  (cond ((struct-closure-p function)
+         (struct-closure-location function))
+        ((c::byte-function-or-closure-p function)
+         (byte-function-location function))
+        (t
+         (compiled-function-location function))))
+
+(defun compiled-function-location (function)
+  "Return the location of a regular compiled function."
+  (multiple-value-bind (code-location error)
+      (safe-definition-finding (function-first-code-location function))
+    (cond (error (list :error (princ-to-string error)))
+          (t (code-location-source-location code-location)))))
+
+(defun function-first-code-location (function)
+  "Return the first code-location we can find for FUNCTION."
+  (and (function-has-debug-function-p function)
+       (di:debug-function-start-location
+        (di:function-debug-function function))))
+
+(defun function-has-debug-function-p (function)
+  (di:function-debug-function function))
+
+(defun function-code-object= (closure function)
+  (and (eq (vm::find-code-object closure)
+	   (vm::find-code-object function))
+       (not (eq closure function))))
+
+
+(defun byte-function-location (fn)
+  "Return the location of the byte-compiled function FN."
+  (etypecase fn
+    ((or c::hairy-byte-function c::simple-byte-function)
+     (let* ((component (c::byte-function-component fn))
+            (debug-info (kernel:%code-debug-info component)))
+       (debug-info-function-name-location debug-info)))
+    (c::byte-closure
+     (byte-function-location (c::byte-closure-function fn)))))
+
+;;; Here we deal with structure accessors. Note that `dd' is a
+;;; "defstruct descriptor" structure in CMUCL. A `dd' describes a
+;;; `defstruct''d structure.
+
+(defun struct-closure-p (function)
+  "Is FUNCTION a closure created by defstruct?"
+  (or (function-code-object= function #'kernel::structure-slot-accessor)
+      (function-code-object= function #'kernel::structure-slot-setter)
+      (function-code-object= function #'kernel::%defstruct)))
+
+(defun struct-closure-location (function)
+  "Return the location of the structure that FUNCTION belongs to."
+  (assert (struct-closure-p function))
+  (safe-definition-finding
+    (dd-location (struct-closure-dd function))))
+
+(defun struct-closure-dd (function)
+  "Return the defstruct-definition (dd) of FUNCTION."
+  (assert (= (kernel:get-type function) vm:closure-header-type))
+  (flet ((find-layout (function)
+	   (sys:find-if-in-closure 
+	    (lambda (x) 
+	      (let ((value (if (di::indirect-value-cell-p x)
+			       (c:value-cell-ref x) 
+			       x)))
+		(when (kernel::layout-p value)
+		  (return-from find-layout value))))
+	    function)))
+    (kernel:layout-info (find-layout function))))
+
+(defun dd-location (dd)
+  "Return the location of a `defstruct'."
+  ;; Find the location in a constructor.
+  (function-location (struct-constructor dd)))
+
+(defun struct-constructor (dd)
+  "Return a constructor function from a defstruct definition.
+Signal an error if no constructor can be found."
+  (let ((constructor (or (kernel:dd-default-constructor dd)
+                         (car (kernel::dd-constructors dd)))))
+    (when (or (null constructor)
+              (and (consp constructor) (null (car constructor))))
+      (error "Cannot find structure's constructor: ~S"
+             (kernel::dd-name dd)))
+    (coerce (if (consp constructor) (first constructor) constructor)
+            'function)))
+
+;;;;;; Generic functions and methods
+
+(defun generic-function-definitions (name function)
+  "Return the definitions of a generic function and its methods."
+  (cons (list `(defgeneric ,name) (gf-location function))
+        (gf-method-definitions function)))
+
+(defun gf-location (gf)
+  "Return the location of the generic function GF."
+  (definition-source-location gf (pcl::generic-function-name gf)))
+
+(defun gf-method-definitions (gf)
+  "Return the locations of all methods of the generic function GF."
+  (mapcar #'method-definition (pcl::generic-function-methods gf)))
+
+(defun method-definition (method)
+  (list (method-dspec method)
+        (method-location method)))
+
+(defun method-dspec (method)
+  "Return a human-readable \"definition specifier\" for METHOD."
+  (let* ((gf (pcl:method-generic-function method))
+         (name (pcl:generic-function-name gf))
+         (specializers (pcl:method-specializers method))
+         (qualifiers (pcl:method-qualifiers method)))
+    `(method ,name , at qualifiers ,(pcl::unparse-specializers specializers))))
+
+;; XXX maybe special case setters/getters
+(defun method-location (method)
+  (function-location (or (pcl::method-fast-function method)
+                         (pcl:method-function method))))
+
+(defun genericp (fn)
+  (typep fn 'generic-function))
+
+;;;;;; Types and classes
+
+(defun type-definitions (name)
+  "Return `deftype' locations for type NAME."
+  (maybe-make-definition (ext:info :type :expander name) 'deftype name))
+
+(defun maybe-make-definition (function kind name)
+  "If FUNCTION is non-nil then return its definition location."
+  (if function
+      (list (list `(,kind ,name) (function-location function)))))
+
+(defun class-definitions (name)
+  "Return the definition locations for the class called NAME."
+  (if (symbolp name)
+      (let ((class (kernel::find-class name nil)))
+        (etypecase class
+          (null '())
+          (kernel::structure-class 
+           (list (list `(defstruct ,name) (dd-location (find-dd name)))))
+          #+(or)
+          (conditions::condition-class
+           (list (list `(define-condition ,name) 
+                       (condition-class-location class))))
+          (kernel::standard-class
+           (list (list `(defclass ,name) 
+                       (class-location (find-class name)))))
+          ((or kernel::built-in-class 
+               conditions::condition-class
+               kernel:funcallable-structure-class)
+           (list (list `(kernel::define-type-class ,name)
+                       `(:error 
+                         ,(format nil "No source info for ~A" name)))))))))
+
+(defun class-location (class)
+  "Return the `defclass' location for CLASS."
+  (definition-source-location class (pcl:class-name class)))
+
+(defun find-dd (name)
+  "Find the defstruct-definition by the name of its structure-class."
+  (let ((layout (ext:info :type :compiler-layout name)))
+    (if layout 
+        (kernel:layout-info layout))))
+
+(defun condition-class-location (class)
+  (let ((slots (conditions::condition-class-slots class))
+        (name (conditions::condition-class-name class)))
+    (cond ((null slots)
+           `(:error ,(format nil "No location info for condition: ~A" name)))
+          (t
+           ;; Find the class via one of its slot-reader methods.
+           (let* ((slot (first slots))
+                  (gf (fdefinition 
+                       (first (conditions::condition-slot-readers slot)))))
+             (method-location 
+              (first 
+               (pcl:compute-applicable-methods-using-classes 
+                gf (list (find-class name))))))))))
+
+(defun make-name-in-file-location (file string)
+  (multiple-value-bind (filename c)
+      (ignore-errors 
+        (unix-truename (merge-pathnames (make-pathname :type "lisp")
+                                        file)))
+    (cond (filename (make-location `(:file ,filename)
+                                   `(:function-name ,(string string))))
+          (t (list :error (princ-to-string c))))))
+
+(defun source-location-form-numbers (location)
+  (c::decode-form-numbers (c::form-numbers-form-numbers location)))
+
+(defun source-location-tlf-number (location)
+  (nth-value 0 (source-location-form-numbers location)))
+
+(defun source-location-form-number (location)
+  (nth-value 1 (source-location-form-numbers location)))
+
+(defun resolve-file-source-location (location)
+  (let ((filename (c::file-source-location-pathname location))
+        (tlf-number (source-location-tlf-number location))
+        (form-number (source-location-form-number location)))
+    (with-open-file (s filename)
+      (let ((pos (form-number-stream-position tlf-number form-number s)))
+        (make-location `(:file ,(unix-truename filename))
+                       `(:position ,(1+ pos)))))))
+
+(defun resolve-stream-source-location (location)
+  (let ((info (c::stream-source-location-user-info location))
+        (tlf-number (source-location-tlf-number location))
+        (form-number (source-location-form-number location)))
+    ;; XXX duplication in frame-source-location
+    (assert (info-from-emacs-buffer-p info))
+    (destructuring-bind (&key emacs-buffer emacs-buffer-string 
+                              emacs-buffer-offset) info
+      (with-input-from-string (s emacs-buffer-string)
+        (let ((pos (form-number-stream-position tlf-number form-number s)))
+          (make-location `(:buffer ,emacs-buffer)
+                         `(:position ,(+ emacs-buffer-offset pos))))))))
+
+;; XXX predicates for 18e backward compatibilty.  Remove them when
+;; we're 19a only.
+(defun file-source-location-p (object) 
+  (when (fboundp 'c::file-source-location-p)
+    (c::file-source-location-p object)))
+
+(defun stream-source-location-p (object)
+  (when (fboundp 'c::stream-source-location-p)
+    (c::stream-source-location-p object)))
+
+(defun source-location-p (object)
+  (or (file-source-location-p object)
+      (stream-source-location-p object)))
+
+(defun resolve-source-location (location)
+  (etypecase location
+    ((satisfies file-source-location-p)
+     (resolve-file-source-location location))
+    ((satisfies stream-source-location-p)
+     (resolve-stream-source-location location))))
+
+(defun definition-source-location (object name)
+  (let ((source (pcl::definition-source object)))
+    (etypecase source
+      (null 
+       `(:error ,(format nil "No source info for: ~A" object)))
+      ((satisfies source-location-p)
+       (resolve-source-location source))
+      (pathname 
+       (make-name-in-file-location source name))
+      (cons
+       (destructuring-bind ((dg name) pathname) source
+         (declare (ignore dg))
+         (etypecase pathname
+           (pathname (make-name-in-file-location pathname (string name)))
+           (null `(:error ,(format nil "Cannot resolve: ~S" source)))))))))
+
+(defun setf-definitions (name)
+  (let ((function (or (ext:info :setf :inverse name)
+                      (ext:info :setf :expander name)
+                      (and (symbolp name)
+                           (fboundp `(setf ,name))
+                           (fdefinition `(setf ,name))))))
+    (if function
+        (list (list `(setf ,name) 
+                    (function-location (coerce function 'function)))))))
+
+
+(defun variable-location (symbol)
+  (multiple-value-bind (location foundp)
+      ;; XXX for 18e compatibilty. rewrite this when we drop 18e
+      ;; support.
+      (ignore-errors (eval `(ext:info :source-location :defvar ',symbol)))
+    (if (and foundp location)
+        (resolve-source-location location)
+        `(:error ,(format nil "No source info for variable ~S" symbol)))))
+
+(defun variable-definitions (name)
+  (if (symbolp name)
+      (multiple-value-bind (kind recorded-p) (ext:info :variable :kind name)
+        (if recorded-p
+            (list (list `(variable ,kind ,name)
+                        (variable-location name)))))))
+
+(defun compiler-macro-definitions (symbol)
+  (maybe-make-definition (compiler-macro-function symbol)
+                         'define-compiler-macro
+                         symbol))
+
+(defun source-transform-definitions (name)
+  (maybe-make-definition (ext:info :function :source-transform name)
+                         'c:def-source-transform
+                         name))
+
+(defun function-info-definitions (name)
+  (let ((info (ext:info :function :info name)))
+    (if info
+        (append (loop for transform in (c::function-info-transforms info)
+                      collect (list `(c:deftransform ,name 
+                                      ,(c::type-specifier 
+                                        (c::transform-type transform)))
+                                    (function-location (c::transform-function 
+                                                        transform))))
+                (maybe-make-definition (c::function-info-derive-type info)
+                                       'c::derive-type name)
+                (maybe-make-definition (c::function-info-optimizer info)
+                                       'c::optimizer name)
+                (maybe-make-definition (c::function-info-ltn-annotate info)
+                                       'c::ltn-annotate name)
+                (maybe-make-definition (c::function-info-ir2-convert info)
+                                       'c::ir2-convert name)
+                (loop for template in (c::function-info-templates info)
+                      collect (list `(c::vop ,(c::template-name template))
+                                    (function-location 
+                                     (c::vop-info-generator-function 
+                                      template))))))))
+
+(defun ir1-translator-definitions (name)
+  (maybe-make-definition (ext:info :function :ir1-convert name)
+                         'c:def-ir1-translator name))
+
+
+;;;; Documentation.
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (flet ((doc (kind)
+             (or (documentation symbol kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (multiple-value-bind (kind recorded-p)
+		     (ext:info variable kind symbol)
+		   (declare (ignore kind))
+		   (if (or (boundp symbol) recorded-p)
+		       (doc 'variable))))
+      (when (fboundp symbol)
+	(maybe-push
+	 (cond ((macro-function symbol)     :macro)
+	       ((special-operator-p symbol) :special-operator)
+	       ((genericp (fdefinition symbol)) :generic-function)
+	       (t :function))
+	 (doc 'function)))
+      (maybe-push
+       :setf (if (or (ext:info setf inverse symbol)
+		     (ext:info setf expander symbol))
+		 (doc 'setf)))
+      (maybe-push
+       :type (if (ext:info type kind symbol)
+		 (doc 'type)))
+      (maybe-push
+       :class (if (find-class symbol nil) 
+		  (doc 'class)))
+      (maybe-push
+       :alien-type (if (not (eq (ext:info alien-type kind symbol) :unknown))
+		       (doc 'alien-type)))
+      (maybe-push
+       :alien-struct (if (ext:info alien-type struct symbol)
+			 (doc nil)))
+      (maybe-push
+       :alien-union (if (ext:info alien-type union symbol)
+			 (doc nil)))
+      (maybe-push
+       :alien-enum (if (ext:info alien-type enum symbol)
+		       (doc nil)))
+      result)))
+
+(defimplementation describe-definition (symbol namespace)
+  (describe (ecase namespace
+              (:variable
+               symbol)
+              ((:function :generic-function)
+               (symbol-function symbol))
+              (:setf
+               (or (ext:info setf inverse symbol)
+                   (ext:info setf expander symbol)))
+              (:type
+               (kernel:values-specifier-type symbol))
+              (:class
+               (find-class symbol))
+              (:alien-struct
+               (ext:info :alien-type :struct symbol))
+              (:alien-union
+               (ext:info :alien-type :union symbol))
+              (:alien-enum
+               (ext:info :alien-type :enum symbol))
+              (:alien-type
+               (ecase (ext:info :alien-type :kind symbol)
+                 (:primitive
+                  (let ((alien::*values-type-okay* t))
+                    (funcall (ext:info :alien-type :translator symbol) 
+                             (list symbol))))
+                 ((:defined)
+                  (ext:info :alien-type :definition symbol))
+                 (:unknown :unkown))))))
+
+;;;;; Argument lists
+
+(defimplementation arglist (fun)
+  (etypecase fun
+    (function (function-arglist fun))
+    (symbol (function-arglist (or (macro-function fun)
+                                  (symbol-function fun))))))
+
+(defun function-arglist (fun)
+  (let ((arglist
+         (cond ((eval:interpreted-function-p fun)
+                (eval:interpreted-function-arglist fun))
+               ((pcl::generic-function-p fun)
+                (pcl:generic-function-lambda-list fun))
+               ((c::byte-function-or-closure-p fun)
+                (byte-code-function-arglist fun))
+               ((kernel:%function-arglist (kernel:%function-self fun))
+                (handler-case (read-arglist fun)
+                  (error () :not-available)))
+               ;; this should work both for compiled-debug-function
+               ;; and for interpreted-debug-function
+               (t 
+                (handler-case (debug-function-arglist 
+                               (di::function-debug-function fun))
+                  (di:unhandled-condition () :not-available))))))
+    (check-type arglist (or list (member :not-available)))
+    arglist))
+
+(defimplementation function-name (function)
+  (cond ((eval:interpreted-function-p function)
+         (eval:interpreted-function-name function))
+        ((pcl::generic-function-p function)
+         (pcl::generic-function-name function))
+        ((c::byte-function-or-closure-p function)
+         (c::byte-function-name function))
+        (t (kernel:%function-name (kernel:%function-self function)))))
+
+;;; A simple case: the arglist is available as a string that we can
+;;; `read'.
+
+(defun read-arglist (fn)
+  "Parse the arglist-string of the function object FN."
+  (let ((string (kernel:%function-arglist 
+                 (kernel:%function-self fn)))
+        (package (find-package
+                  (c::compiled-debug-info-package
+                   (kernel:%code-debug-info
+                    (vm::find-code-object fn))))))
+    (with-standard-io-syntax
+      (let ((*package* (or package *package*)))
+        (read-from-string string)))))
+
+;;; A harder case: an approximate arglist is derived from available
+;;; debugging information.
+
+(defun debug-function-arglist (debug-function)
+  "Derive the argument list of DEBUG-FUNCTION from debug info."
+  (let ((args (di::debug-function-lambda-list debug-function))
+        (required '())
+        (optional '())
+        (rest '())
+        (key '()))
+    ;; collect the names of debug-vars
+    (dolist (arg args)
+      (etypecase arg
+        (di::debug-variable 
+         (push (di::debug-variable-symbol arg) required))
+        ((member :deleted)
+         (push ':deleted required))
+        (cons
+         (ecase (car arg)
+           (:keyword 
+            (push (second arg) key))
+           (:optional
+            (push (debug-variable-symbol-or-deleted (second arg)) optional))
+           (:rest 
+            (push (debug-variable-symbol-or-deleted (second arg)) rest))))))
+    ;; intersperse lambda keywords as needed
+    (append (nreverse required)
+            (if optional (cons '&optional (nreverse optional)))
+            (if rest (cons '&rest (nreverse rest)))
+            (if key (cons '&key (nreverse key))))))
+
+(defun debug-variable-symbol-or-deleted (var)
+  (etypecase var
+    (di:debug-variable
+     (di::debug-variable-symbol var))
+    ((member :deleted)
+     '#:deleted)))
+
+(defun symbol-debug-function-arglist (fname)
+  "Return FNAME's debug-function-arglist and %function-arglist.
+A utility for debugging DEBUG-FUNCTION-ARGLIST."
+  (let ((fn (fdefinition fname)))
+    (values (debug-function-arglist (di::function-debug-function fn))
+            (kernel:%function-arglist (kernel:%function-self fn)))))
+
+;;; Deriving arglists for byte-compiled functions:
+;;;
+(defun byte-code-function-arglist (fn)
+  ;; There doesn't seem to be much arglist information around for
+  ;; byte-code functions.  Use the arg-count and return something like
+  ;; (arg0 arg1 ...)
+  (etypecase fn
+    (c::simple-byte-function 
+     (loop for i from 0 below (c::simple-byte-function-num-args fn)
+           collect (make-arg-symbol i)))
+    (c::hairy-byte-function 
+     (hairy-byte-function-arglist fn))
+    (c::byte-closure
+     (byte-code-function-arglist (c::byte-closure-function fn)))))
+
+(defun make-arg-symbol (i)
+  (make-symbol (format nil "~A~D" (string 'arg) i)))
+
+;;; A "hairy" byte-function is one that takes a variable number of
+;;; arguments. `hairy-byte-function' is a type from the bytecode
+;;; interpreter.
+;;;
+(defun hairy-byte-function-arglist (fn)
+  (let ((counter -1))
+    (flet ((next-arg () (make-arg-symbol (incf counter))))
+      (with-struct (c::hairy-byte-function- min-args max-args rest-arg-p
+                                            keywords-p keywords) fn
+        (let ((arglist '())
+              (optional (- max-args min-args)))
+          ;; XXX isn't there a better way to write this?
+          ;; (Looks fine to me. -luke)
+          (dotimes (i min-args)
+            (push (next-arg) arglist))
+          (when (plusp optional)
+            (push '&optional arglist)
+            (dotimes (i optional)
+              (push (next-arg) arglist)))
+          (when rest-arg-p
+            (push '&rest arglist)
+            (push (next-arg) arglist))
+          (when keywords-p
+            (push '&key arglist)
+            (loop for (key _ __) in keywords
+                  do (push key arglist))
+            (when (eq keywords-p :allow-others)
+              (push '&allow-other-keys arglist)))
+          (nreverse arglist))))))
+
+
+;;;; Miscellaneous.
+
+(defimplementation macroexpand-all (form)
+  (walker:macroexpand-all form))
+
+(defimplementation compiler-macroexpand-1 (form &optional env)
+  (ext:compiler-macroexpand-1 form env))
+
+(defimplementation compiler-macroexpand (form &optional env)
+  (ext:compiler-macroexpand form env))
+
+(defimplementation set-default-directory (directory)
+  (setf (ext:default-directory) (namestring directory))
+  ;; Setting *default-pathname-defaults* to an absolute directory
+  ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+  (setf *default-pathname-defaults* (pathname (ext:default-directory)))
+  (default-directory))
+
+(defimplementation default-directory ()
+  (namestring (ext:default-directory)))
+
+(defimplementation call-without-interrupts (fn)
+  (sys:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+  (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  "cmucl")
+
+(defimplementation quit-lisp ()
+  (ext::quit))
+
+;;; source-path-{stream,file,string,etc}-position moved into 
+;;; swank-source-path-parser
+
+
+;;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (unix:unix-sigsetmask 0)
+  (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+	 (debug:*stack-top-hint* nil)
+         (kernel:*current-level* 0))
+    (handler-bind ((di::unhandled-condition
+		    (lambda (condition)
+                      (error (make-condition
+                              'sldb-condition
+                              :original-condition condition)))))
+      (unwind-protect
+           (progn
+             #+(or)(sys:scrub-control-stack)
+             (funcall debugger-loop-fn))
+        #+(or)(sys:scrub-control-stack)
+        ))))
+
+(defun frame-down (frame)
+  (handler-case (di:frame-down frame)
+    (di:no-debug-info () nil)))
+
+(defun nth-frame (index)
+  (do ((frame *sldb-stack-top* (frame-down frame))
+       (i index (1- i)))
+      ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+  (let ((end (or end most-positive-fixnum)))
+    (loop for f = (nth-frame start) then (frame-down f)
+	  for i from start below end
+	  while f
+	  collect f)))
+
+(defimplementation print-frame (frame stream)
+  (let ((*standard-output* stream))
+    (handler-case 
+        (debug::print-frame-call frame :verbosity 1 :number nil)
+      (error (e)
+        (ignore-errors (princ e stream))))))
+
+(defimplementation frame-source-location-for-emacs (index)
+  (code-location-source-location (di:frame-code-location (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+  (di:eval-in-frame (nth-frame index) form))
+
+(defun frame-debug-vars (frame)
+  "Return a vector of debug-variables in frame."
+  (di::debug-function-debug-variables (di:frame-debug-function frame)))
+
+(defun debug-var-value (var frame location)
+  (let ((validity (di:debug-variable-validity var location)))
+    (ecase validity
+      (:valid (di:debug-variable-value var frame))
+      ((:invalid :unknown) (make-symbol (string validity))))))
+
+(defimplementation frame-locals (index)
+  (let* ((frame (nth-frame index))
+	 (loc (di:frame-code-location frame))
+	 (vars (frame-debug-vars frame)))
+    (loop for v across vars collect
+          (list :name (di:debug-variable-symbol v)
+                :id (di:debug-variable-id v)
+                :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+  (let* ((frame (nth-frame frame))
+         (dvar (aref (frame-debug-vars frame) var)))
+    (debug-var-value dvar frame (di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+  (mapcar #'car (di:frame-catches (nth-frame index))))
+
+(defimplementation return-from-frame (index form)
+  (let ((sym (find-symbol (string 'find-debug-tag-for-frame)
+                          :debug-internals)))
+    (if sym
+        (let* ((frame (nth-frame index))
+               (probe (funcall sym frame)))
+          (cond (probe (throw (car probe) (eval-in-frame form index)))
+                (t (format nil "Cannot return from frame: ~S" frame))))
+        "return-from-frame is not implemented in this version of CMUCL.")))
+
+(defimplementation activate-stepping (frame)
+  (set-step-breakpoints (nth-frame frame)))
+
+(defimplementation sldb-break-on-return (frame)
+  (break-on-return (nth-frame frame)))
+
+;;; We set the breakpoint in the caller which might be a bit confusing.
+;;;
+(defun break-on-return (frame)
+  (let* ((caller (di:frame-down frame))
+         (cl (di:frame-code-location caller)))
+    (flet ((hook (frame bp)
+             (when (frame-pointer= frame caller)
+               (di:delete-breakpoint bp)
+               (signal-breakpoint bp frame))))
+      (let* ((info (ecase (di:code-location-kind cl)
+                     ((:single-value-return :unknown-return) nil)
+                     (:known-return (debug-function-returns 
+                                     (di:frame-debug-function frame)))))
+             (bp (di:make-breakpoint #'hook cl :kind :code-location
+                                     :info info)))
+        (di:activate-breakpoint bp)
+        `(:ok ,(format nil "Set breakpoint in ~A" caller))))))
+
+(defun frame-pointer= (frame1 frame2)
+  "Return true if the frame pointers of FRAME1 and FRAME2 are the same."
+  (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2)))
+
+;;; The PC in escaped frames at a single-return-value point is
+;;; actually vm:single-value-return-byte-offset bytes after the
+;;; position given in the debug info.  Here we try to recognize such
+;;; cases.
+;;;
+(defun next-code-locations (frame code-location)
+  "Like `debug::next-code-locations' but be careful in escaped frames."
+  (let ((next (debug::next-code-locations code-location)))
+    (flet ((adjust-pc ()
+             (let ((cl (di::copy-compiled-code-location code-location)))
+               (incf (di::compiled-code-location-pc cl) 
+                     vm:single-value-return-byte-offset)
+               cl)))
+      (cond ((and (di::compiled-frame-escaped frame)
+                  (eq (di:code-location-kind code-location)
+                      :single-value-return)
+                  (= (length next) 1)
+                  (di:code-location= (car next) (adjust-pc)))
+             (debug::next-code-locations (car next)))
+            (t
+             next)))))
+
+(defun set-step-breakpoints (frame)
+  (let ((cl (di:frame-code-location frame)))
+    (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl))
+      (error "Cannot step in elsewhere code"))
+    (let* ((debug::*bad-code-location-types*
+            (remove :call-site debug::*bad-code-location-types*))
+           (next (next-code-locations frame cl)))
+      (cond (next
+             (let ((steppoints '()))
+               (flet ((hook (bp-frame bp)
+                        (signal-breakpoint bp bp-frame)
+                        (mapc #'di:delete-breakpoint steppoints)))
+                 (dolist (code-location next)
+                   (let ((bp (di:make-breakpoint #'hook code-location
+                                                 :kind :code-location)))
+                     (di:activate-breakpoint bp)
+                     (push bp steppoints))))))
+            (t
+             (break-on-return frame))))))
+
+
+;; XXX the return values at return breakpoints should be passed to the
+;; user hooks. debug-int.lisp should be changed to do this cleanly.
+
+;;; The sigcontext and the PC for a breakpoint invocation are not
+;;; passed to user hook functions, but we need them to extract return
+;;; values. So we advice di::handle-breakpoint and bind the values to
+;;; special variables.  
+;;;
+(defvar *breakpoint-sigcontext*)
+(defvar *breakpoint-pc*)
+
+;; XXX don't break old versions without fwrappers.  Remove this one day.
+#+#.(cl:if (cl:find-package :fwrappers) '(and) '(or))
+(progn
+  (fwrappers:define-fwrapper bind-breakpoint-sigcontext (offset c sigcontext)
+    (let ((*breakpoint-sigcontext* sigcontext)
+          (*breakpoint-pc* offset))
+      (fwrappers:call-next-function)))
+  (fwrappers:set-fwrappers 'di::handle-breakpoint '())
+  (fwrappers:fwrap 'di::handle-breakpoint #'bind-breakpoint-sigcontext))
+
+(defun sigcontext-object (sc index)
+  "Extract the lisp object in sigcontext SC at offset INDEX."
+  (kernel:make-lisp-obj (vm:sigcontext-register sc index)))
+
+(defun known-return-point-values (sigcontext sc-offsets)
+  (let ((fp (system:int-sap (vm:sigcontext-register sigcontext
+                                                    vm::cfp-offset))))
+    (system:without-gcing
+     (loop for sc-offset across sc-offsets
+           collect (di::sub-access-debug-var-slot fp sc-offset sigcontext)))))
+
+;;; CMUCL returns the first few values in registers and the rest on
+;;; the stack. In the multiple value case, the number of values is
+;;; stored in a dedicated register. The values of the registers can be
+;;; accessed in the sigcontext for the breakpoint.  There are 3 kinds
+;;; of return conventions: :single-value-return, :unknown-return, and
+;;; :known-return.
+;;;
+;;; The :single-value-return convention returns the value in a
+;;; register without setting the nargs registers.  
+;;;
+;;; The :unknown-return variant is used for multiple values. A
+;;; :unknown-return point consists actually of 2 breakpoints: one for
+;;; the single value case and one for the general case.  The single
+;;; value breakpoint comes vm:single-value-return-byte-offset after
+;;; the multiple value breakpoint.
+;;;
+;;; The :known-return convention is used by local functions.
+;;; :known-return is currently not supported because we don't know
+;;; where the values are passed.
+;;;
+(defun breakpoint-values (breakpoint)
+  "Return the list of return values for a return point."
+  (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets))))
+    (let ((sc (locally (declare (optimize (ext:inhibit-warnings 3)))
+                (alien:sap-alien *breakpoint-sigcontext* (* unix:sigcontext))))
+          (cl (di:breakpoint-what breakpoint)))
+      (ecase (di:code-location-kind cl)
+        (:single-value-return
+         (list (1st sc)))
+        (:known-return
+         (let ((info (di:breakpoint-info breakpoint)))
+           (if (vectorp info)
+               (known-return-point-values sc info)
+               (progn 
+                 ;;(break)
+                 (list "<<known-return convention not supported>>" info)))))
+        (:unknown-return
+         (let ((mv-return-pc (di::compiled-code-location-pc cl)))
+           (if (= mv-return-pc *breakpoint-pc*)
+               (mv-function-end-breakpoint-values sc)
+               (list (1st sc)))))))))
+
+;; XXX: di::get-function-end-breakpoint-values takes 2 arguments in
+;; newer versions of CMUCL (after ~March 2005).
+(defun mv-function-end-breakpoint-values (sigcontext)
+  (let ((sym (find-symbol "FUNCTION-END-BREAKPOINT-VALUES/STANDARD" :di)))
+    (cond (sym (funcall sym sigcontext))
+          (t (di::get-function-end-breakpoint-values sigcontext)))))
+
+(defun debug-function-returns (debug-fun)
+  "Return the return style of DEBUG-FUN."
+  (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun)))
+    (c::compiled-debug-function-returns cdfun)))
+
+(define-condition breakpoint (simple-condition) 
+  ((message :initarg :message :reader breakpoint.message)
+   (values  :initarg :values  :reader breakpoint.values))
+  (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
+
+(defimplementation condition-extras (condition)
+  (typecase condition
+    (breakpoint 
+     ;; pop up the source buffer
+     `((:show-frame-source 0))) 
+    (t '())))
+
+(defun signal-breakpoint (breakpoint frame)
+  "Signal a breakpoint condition for BREAKPOINT in FRAME.
+Try to create a informative message."
+  (flet ((brk (values fstring &rest args)
+           (let ((msg (apply #'format nil fstring args))
+                 (debug:*stack-top-hint* frame))
+             (break 'breakpoint :message msg :values values))))
+    (with-struct (di::breakpoint- kind what) breakpoint
+      (case kind
+        (:code-location
+         (case (di:code-location-kind what)
+           ((:single-value-return :known-return :unknown-return)
+            (let ((values (breakpoint-values breakpoint)))
+              (brk values "Return value: ~{~S ~}" values)))
+           (t
+            #+(or)
+            (when (eq (di:code-location-kind what) :call-site)
+              (call-site-function breakpoint frame))
+            (brk nil "Breakpoint: ~S ~S" 
+                 (di:code-location-kind what)
+                 (di::compiled-code-location-pc what)))))
+        (:function-start
+         (brk nil "Function start breakpoint"))
+        (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
+
+(defimplementation sldb-break-at-start (fname)
+  (let ((debug-fun (di:function-debug-function (coerce fname 'function))))
+    (cond ((not debug-fun)
+           `(:error ,(format nil "~S has no debug-function" fname)))
+          (t
+           (flet ((hook (frame bp &optional args cookie)
+                    (declare (ignore args cookie))
+                    (signal-breakpoint bp frame)))
+             (let ((bp (di:make-breakpoint #'hook debug-fun
+                                           :kind :function-start)))
+               (di:activate-breakpoint bp)
+               `(:ok ,(format nil "Set breakpoint in ~S" fname))))))))
+
+(defun frame-cfp (frame)
+  "Return the Control-Stack-Frame-Pointer for FRAME."
+  (etypecase frame
+    (di::compiled-frame (di::frame-pointer frame))
+    ((or di::interpreted-frame null) -1)))
+
+(defun frame-ip (frame)
+  "Return the (absolute) instruction pointer and the relative pc of FRAME."
+  (if (not frame)
+      -1
+      (let ((debug-fun (di::frame-debug-function frame)))
+        (etypecase debug-fun
+          (di::compiled-debug-function 
+           (let* ((code-loc (di:frame-code-location frame))
+                  (component (di::compiled-debug-function-component debug-fun))
+                  (pc (di::compiled-code-location-pc code-loc))
+                  (ip (sys:without-gcing
+                       (sys:sap-int
+                        (sys:sap+ (kernel:code-instructions component) pc)))))
+             (values ip pc)))
+          ((or di::bogus-debug-function di::interpreted-debug-function)
+           -1)))))
+
+(defun frame-registers (frame)
+  "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
+  (let* ((cfp (frame-cfp frame))
+         (csp (frame-cfp (di::frame-up frame)))
+         (ip (frame-ip frame))
+         (ocfp (frame-cfp (di::frame-down frame)))
+         (lra (frame-ip (di::frame-down frame))))
+    (values csp cfp ip ocfp lra)))
+
+(defun print-frame-registers (frame-number)
+  (let ((frame (di::frame-real-frame (nth-frame frame-number))))
+    (flet ((fixnum (p) (etypecase p
+                         (integer p)
+                         (sys:system-area-pointer (sys:sap-int p)))))
+      (apply #'format t "~
+CSP  =  ~X
+CFP  =  ~X
+IP   =  ~X
+OCFP =  ~X
+LRA  =  ~X~%" (mapcar #'fixnum 
+                      (multiple-value-list (frame-registers frame)))))))
+
+
+(defimplementation disassemble-frame (frame-number)
+  "Return a string with the disassembly of frames code."
+  (print-frame-registers frame-number)
+  (terpri)
+  (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+         (debug-fun (di::frame-debug-function frame)))
+    (etypecase debug-fun
+      (di::compiled-debug-function
+       (let* ((component (di::compiled-debug-function-component debug-fun))
+              (fun (di:debug-function-function debug-fun)))
+         (if fun
+             (disassemble fun)
+             (disassem:disassemble-code-component component))))
+      (di::bogus-debug-function
+       (format t "~%[Disassembling bogus frames not implemented]")))))
+
+
+;;;; Inspecting
+
+(defclass cmucl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'cmucl-inspector))
+
+(defconstant +lowtag-symbols+ 
+  '(vm:even-fixnum-type
+    vm:function-pointer-type
+    vm:other-immediate-0-type
+    vm:list-pointer-type
+    vm:odd-fixnum-type
+    vm:instance-pointer-type
+    vm:other-immediate-1-type
+    vm:other-pointer-type)
+  "Names of the constants that specify type tags.
+The `symbol-value' of each element is a type tag.")
+
+(defconstant +header-type-symbols+
+  (labels ((suffixp (suffix string)
+             (and (>= (length string) (length suffix))
+                  (string= string suffix :start1 (- (length string) 
+                                                    (length suffix)))))
+           (header-type-symbol-p (x)
+             (and (suffixp "-TYPE" (symbol-name x))
+                  (not (member x +lowtag-symbols+))
+                  (boundp x)
+                  (typep (symbol-value x) 'fixnum))))
+    (remove-if-not #'header-type-symbol-p
+                   (append (apropos-list "-TYPE" "VM")
+                           (apropos-list "-TYPE" "BIGNUM"))))
+  "A list of names of the type codes in boxed objects.")
+
+(defimplementation describe-primitive-type (object)
+  (with-output-to-string (*standard-output*)
+    (let* ((lowtag (kernel:get-lowtag object))
+	   (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
+      (format t "lowtag: ~A" lowtag-symbol)
+      (when (member lowtag (list vm:other-pointer-type
+                                 vm:function-pointer-type
+                                 vm:other-immediate-0-type
+                                 vm:other-immediate-1-type
+                                 ))
+        (let* ((type (kernel:get-type object))
+               (type-symbol (find type +header-type-symbols+
+                                  :key #'symbol-value)))
+          (format t ", type: ~A" type-symbol))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (cond ((di::indirect-value-cell-p o)
+         (values (format nil "~A is a value cell." o)
+                 `("Value: " (:value ,(c:value-cell-ref o)))))
+        ((alien::alien-value-p o)
+         (inspect-alien-value o))
+	(t
+         (cmucl-inspect o))))
+
+(defun cmucl-inspect (o)
+  (destructuring-bind (text labeledp . parts) (inspect::describe-parts o)
+    (values (format nil "~A~%" text)
+            (if labeledp
+                (loop for (label . value) in parts
+                      append (label-value-line label value))
+                (loop for value in parts  for i from 0 
+                      append (label-value-line i value))))))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (let ((header (kernel:get-type o)))
+    (cond ((= header vm:function-header-type)
+           (values (format nil "~A is a function." o)
+                   (append (label-value-line*
+                            ("Self" (kernel:%function-self o))
+                            ("Next" (kernel:%function-next o))
+                            ("Name" (kernel:%function-name o))
+                            ("Arglist" (kernel:%function-arglist o))
+                            ("Type" (kernel:%function-type o))
+                            ("Code" (kernel:function-code-header o)))
+                           (list 
+                            (with-output-to-string (s)
+                              (disassem:disassemble-function o :stream s))))))
+          ((= header vm:closure-header-type)
+           (values (format nil "~A is a closure" o)
+                   (append 
+                    (label-value-line "Function" (kernel:%closure-function o))
+                    `("Environment:" (:newline))
+                    (loop for i from 0 below (1- (kernel:get-closure-length o))
+                          append (label-value-line 
+                                  i (kernel:%closure-index-ref o i))))))
+          ((eval::interpreted-function-p o)
+           (cmucl-inspect o))
+          (t
+           (call-next-method)))))
+
+(defmethod inspect-for-emacs ((o kernel:funcallable-instance)
+                              (i backend-inspector))
+  (declare (ignore i))
+  (values 
+   (format nil "~A is a funcallable-instance." o)
+   (append (label-value-line* 
+            (:function (kernel:%funcallable-instance-function o))
+            (:lexenv  (kernel:%funcallable-instance-lexenv o))
+            (:layout  (kernel:%funcallable-instance-layout o)))
+           (nth-value 1 (cmucl-inspect o)))))
+
+(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector))
+  (declare (ignore _))
+  (values (format nil "~A is a code data-block." o)
+          (append 
+           (label-value-line* 
+            ("code-size" (kernel:%code-code-size o))
+            ("entry-points" (kernel:%code-entry-points o))
+            ("debug-info" (kernel:%code-debug-info o))
+            ("trace-table-offset" (kernel:code-header-ref 
+                                   o vm:code-trace-table-offset-slot)))
+           `("Constants:" (:newline))
+           (loop for i from vm:code-constants-offset 
+                 below (kernel:get-header-data o)
+                 append (label-value-line i (kernel:code-header-ref o i)))
+           `("Code:" (:newline)
+             , (with-output-to-string (s)
+                 (cond ((kernel:%code-debug-info o)
+                        (disassem:disassemble-code-component o :stream s))
+                       (t
+                        (disassem:disassemble-memory 
+                         (disassem::align 
+                          (+ (logandc2 (kernel:get-lisp-obj-address o)
+                                       vm:lowtag-mask)
+                             (* vm:code-constants-offset vm:word-bytes))
+                          (ash 1 vm:lowtag-bits))
+                         (ash (kernel:%code-code-size o) vm:word-shift)
+                         :stream s))))))))
+
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values (format nil "~A is a fdenf object." o)
+          (label-value-line*
+           ("name" (kernel:fdefn-name o))
+           ("function" (kernel:fdefn-function o))
+           ("raw-addr" (sys:sap-ref-32
+                        (sys:int-sap (kernel:get-lisp-obj-address o))
+                        (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+
+(defmethod inspect-for-emacs ((o array) (inspector backend-inspector))
+  inspector
+  (if (typep o 'simple-array)
+      (call-next-method)
+      (values (format nil "~A is an array." o)
+              (label-value-line*
+               (:header (describe-primitive-type o))
+               (:rank (array-rank o))
+               (:fill-pointer (kernel:%array-fill-pointer o))
+               (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+               (:elements (kernel:%array-available-elements o))           
+               (:data (kernel:%array-data-vector o))
+               (:displacement (kernel:%array-displacement o))
+               (:displaced-p (kernel:%array-displaced-p o))
+               (:dimensions (array-dimensions o))))))
+
+(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector))
+  inspector
+  (values (format nil "~A is a simple-vector." o)
+          (append 
+           (label-value-line*
+            (:header (describe-primitive-type o))
+            (:length (c::vector-length o)))
+           (loop for i below (length o)
+                 append (label-value-line i (aref o i))))))
+
+(defun inspect-alien-record (alien)
+  (values
+   (format nil "~A is an alien value." alien)
+   (with-struct (alien::alien-value- sap type) alien
+     (with-struct (alien::alien-record-type- kind name fields) type
+       (append
+        (label-value-line*
+         (:sap sap)
+         (:kind kind)
+         (:name name))
+        (loop for field in fields 
+              append (let ((slot (alien::alien-record-field-name field)))
+                       (label-value-line slot (alien:slot alien slot)))))))))
+
+(defun inspect-alien-pointer (alien)
+  (values
+   (format nil "~A is an alien value." alien)
+   (with-struct (alien::alien-value- sap type) alien
+     (label-value-line* 
+      (:sap sap)
+      (:type type)
+      (:to (alien::deref alien))))))
+  
+(defun inspect-alien-value (alien)
+  (typecase (alien::alien-value-type alien)
+    (alien::alien-record-type (inspect-alien-record alien))
+    (alien::alien-pointer-type (inspect-alien-pointer alien))
+    (t (cmucl-inspect alien))))
+
+;;;; Profiling
+(defimplementation profile (fname)
+  (eval `(profile:profile ,fname)))
+
+(defimplementation unprofile (fname)
+  (eval `(profile:unprofile ,fname)))
+
+(defimplementation unprofile-all ()
+  (eval `(profile:unprofile))
+  "All functions unprofiled.")
+
+(defimplementation profile-report ()
+  (eval `(profile:report-time)))
+
+(defimplementation profile-reset ()
+  (eval `(profile:reset-time))
+  "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+  profile:*timed-functions*)
+
+(defimplementation profile-package (package callers methods)
+  (profile:profile-all :package package
+                       :callers-p callers
+                       #-cmu18e :methods #-cmu18e methods))
+
+
+;;;; Multiprocessing
+
+#+mp
+(progn
+  (defimplementation initialize-multiprocessing (continuation) 
+    (mp::init-multi-processing)
+    (mp:make-process continuation :name "swank")
+    ;; Threads magic: this never returns! But top-level becomes
+    ;; available again.
+    (unless mp::*idle-process*
+      (mp::startup-idle-and-top-level-loops)))
+  
+  (defimplementation spawn (fn &key name)
+    (mp:make-process fn :name (or name "Anonymous")))
+
+  (defvar *thread-id-counter* 0)
+
+  (defimplementation thread-id (thread)
+    (or (getf (mp:process-property-list thread) 'id)
+        (setf (getf (mp:process-property-list thread) 'id)
+              (incf *thread-id-counter*))))
+
+  (defimplementation find-thread (id)
+    (find id (all-threads)
+          :key (lambda (p) (getf (mp:process-property-list p) 'id))))
+
+  (defimplementation thread-name (thread)
+    (mp:process-name thread))
+
+  (defimplementation thread-status (thread)
+    (mp:process-whostate thread))
+
+  (defimplementation current-thread ()
+    mp:*current-process*)
+
+  (defimplementation all-threads ()
+    (copy-list mp:*all-processes*))
+
+  (defimplementation interrupt-thread (thread fn)
+    (mp:process-interrupt thread fn))
+
+  (defimplementation kill-thread (thread)
+    (mp:destroy-process thread))
+
+  (defvar *mailbox-lock* (mp:make-lock "mailbox lock"))
+  
+  (defstruct (mailbox (:conc-name mailbox.)) 
+    (mutex (mp:make-lock "process mailbox"))
+    (queue '() :type list))
+
+  (defun mailbox (thread)
+    "Return THREAD's mailbox."
+    (mp:with-lock-held (*mailbox-lock*)
+      (or (getf (mp:process-property-list thread) 'mailbox)
+          (setf (getf (mp:process-property-list thread) 'mailbox)
+                (make-mailbox)))))
+  
+  (defimplementation send (thread message)
+    (let* ((mbox (mailbox thread))
+           (mutex (mailbox.mutex mbox)))
+      (mp:with-lock-held (mutex)
+        (setf (mailbox.queue mbox)
+              (nconc (mailbox.queue mbox) (list message))))))
+  
+  (defimplementation receive ()
+    (let* ((mbox (mailbox mp:*current-process*))
+           (mutex (mailbox.mutex mbox)))
+      (mp:process-wait "receive" #'mailbox.queue mbox)
+      (mp:with-lock-held (mutex)
+        (pop (mailbox.queue mbox)))))
+
+  ) ;; #+mp
+
+
+
+;;;; GC hooks 
+;;;
+;;; Display GC messages in the echo area to avoid cluttering the
+;;; normal output.
+;;;
+
+;; this should probably not be here, but where else?
+(defun background-message (message)
+  (funcall (find-symbol (string :background-message) :swank)
+           message))
+
+(defun print-bytes (nbytes &optional stream)
+  "Print the number NBYTES to STREAM in KB, MB, or GB units."
+  (let ((names '((0 bytes) (10 kb) (20 mb) (30 gb) (40 tb) (50 eb))))
+    (multiple-value-bind (power name)
+	(loop for ((p1 n1) (p2 n2)) on names
+	      while n2 do
+	      (when (<= (expt 2 p1) nbytes (1- (expt 2 p2)))
+		(return (values p1 n1))))
+      (cond (name
+	     (format stream "~,1F ~A" (/ nbytes (expt 2 power)) name))
+	    (t
+	     (format stream "~:D bytes" nbytes))))))
+
+(defconstant gc-generations 6)
+
+#+gencgc
+(defun generation-stats ()
+  "Return a string describing the size distribution among the generations."
+  (let* ((alloc (loop for i below gc-generations
+                      collect (lisp::gencgc-stats i)))
+         (sum (coerce (reduce #'+ alloc) 'float)))
+    (format nil "~{~3F~^/~}" 
+            (mapcar (lambda (size) (/ size sum))
+                    alloc))))
+
+(defvar *gc-start-time* 0)
+
+(defun pre-gc-hook (bytes-in-use)
+  (setq *gc-start-time* (get-internal-real-time))
+  (let ((msg (format nil "[Commencing GC with ~A in use.]" 
+		     (print-bytes bytes-in-use))))
+    (background-message msg)))
+
+(defun post-gc-hook (bytes-retained bytes-freed trigger)
+  (declare (ignore trigger))
+  (let* ((seconds (/ (- (get-internal-real-time) *gc-start-time*)
+                     internal-time-units-per-second))
+         (msg (format nil "[GC done. ~A freed  ~A retained  ~A  ~4F sec]"
+		     (print-bytes bytes-freed)
+		     (print-bytes bytes-retained)
+                     #+gencgc(generation-stats)
+                     #-gencgc""
+                     seconds)))
+    (background-message msg)))
+
+(defun install-gc-hooks ()
+  (setq ext:*gc-notify-before* #'pre-gc-hook)
+  (setq ext:*gc-notify-after* #'post-gc-hook))
+
+(defun remove-gc-hooks ()
+  (setq ext:*gc-notify-before* #'lisp::default-gc-notify-before)
+  (setq ext:*gc-notify-after* #'lisp::default-gc-notify-after))
+
+(defvar *install-gc-hooks* t
+  "If non-nil install GC hooks")
+
+(defimplementation emacs-connected ()
+  (when *install-gc-hooks*
+    (install-gc-hooks)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;;In CMUCL, we have:
+;; (trace <name>)
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; (trace :methods t '<name>) ;;to trace all methods of the gf <name>
+;; <name> can be a normal name or a (setf name)
+
+(defun tracedp (spec)
+  (member spec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (spec &rest options)
+  (cond ((tracedp spec)
+         (eval `(untrace ,spec))
+         (format nil "~S is now untraced." spec))
+        (t
+         (eval `(trace ,spec , at options))
+         (format nil "~S is now traced." spec))))
+
+(defimplementation toggle-trace (spec)
+  (ecase (car spec)
+    ((setf)
+     (toggle-trace-aux spec))
+    ((:defgeneric)
+     (let ((name (second spec)))
+       (toggle-trace-aux name :methods name)))
+    ((:defmethod)
+     (cond ((fboundp `(method ,@(cdr spec)))
+            (toggle-trace-aux `(method ,(cdr spec))))
+           ;; Man, is this ugly
+           ((fboundp `(pcl::fast-method ,@(cdr spec)))
+            (toggle-trace-aux `(pcl::fast-method ,@(cdr spec))))
+           (t
+            (error 'undefined-function :name (cdr spec)))))
+    ((:call)
+     (destructuring-bind (caller callee) (cdr spec)
+       (toggle-trace-aux (process-fspec callee) 
+                         :wherein (list (process-fspec caller)))))
+    ;; doesn't work properly
+    ;; ((:labels :flet) (toggle-trace-aux (process-fspec spec)))
+    ))
+
+(defun process-fspec (fspec)
+  (cond ((consp fspec)
+         (ecase (first fspec)
+           ((:defun :defgeneric) (second fspec))
+           ((:defmethod) 
+            `(method ,(second fspec) ,@(third fspec) ,(fourth fspec)))
+           ((:labels) `(labels ,(third fspec) ,(process-fspec (second fspec))))
+           ((:flet) `(flet ,(third fspec) ,(process-fspec (second fspec))))))
+        (t
+         fspec)))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+  (apply #'make-hash-table :weak-p t args))
+
+;; Local Variables:
+;; pbook-heading-regexp:    "^;;;\\(;+\\)"
+;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)"
+;; End:

Added: branches/trunk-reorg/thirdparty/slime/swank-corman.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-corman.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-corman.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,580 @@
+;;;
+;;; swank-corman.lisp --- Corman Lisp specific code for SLIME.
+;;;
+;;; Copyright (C) 2004, 2005 Espen Wiborg (espenhw at grumblesmurf.org)
+;;;
+;;; License
+;;; =======
+;;; This software is provided 'as-is', without any express or implied
+;;; warranty. In no event will the author be held liable for any damages
+;;; arising from the use of this software.
+;;;
+;;; Permission is granted to anyone to use this software for any purpose,
+;;; including commercial applications, and to alter it and redistribute
+;;; it freely, subject to the following restrictions:
+;;;
+;;; 1. The origin of this software must not be misrepresented; you must
+;;;    not claim that you wrote the original software. If you use this
+;;;    software in a product, an acknowledgment in the product documentation
+;;;    would be appreciated but is not required.
+;;;
+;;; 2. Altered source versions must be plainly marked as such, and must
+;;;    not be misrepresented as being the original software.
+;;;
+;;; 3. This notice may not be removed or altered from any source 
+;;;    distribution.
+;;;
+;;; Notes
+;;; =====
+;;; You will need CCL 2.51, and you will *definitely* need to patch
+;;; CCL with the patches at
+;;; http://www.grumblesmurf.org/lisp/corman-patches, otherwise SLIME
+;;; will blow up in your face.  You should also follow the
+;;; instructions on http://www.grumblesmurf.org/lisp/corman-slime.
+;;;
+;;; The only communication style currently supported is NIL.
+;;;
+;;; Starting CCL inside emacs (with M-x slime) seems to work for me
+;;; with Corman Lisp 2.51, but I have seen random failures with 2.5
+;;; (sometimes it works, other times it hangs on start or hangs when
+;;; initializing WinSock) - starting CCL externally and using M-x
+;;; slime-connect always works fine.
+;;;
+;;; Sometimes CCL gets confused and starts giving you random memory
+;;; access violation errors on startup; if this happens, try redumping
+;;; your image.
+;;;
+;;; What works
+;;; ==========
+;;; * Basic editing and evaluation
+;;; * Arglist display
+;;; * Compilation
+;;; * Loading files
+;;; * apropos/describe
+;;; * Debugger
+;;; * Inspector
+;;; 
+;;; TODO
+;;; ====
+;;; * More debugger functionality (missing bits: restart-frame,
+;;; return-from-frame, disassemble-frame, activate-stepping,
+;;; toggle-trace)
+;;; * XREF
+;;; * Profiling
+;;; * More sophisticated communication styles than NIL
+;;;
+
+(in-package :swank-backend)
+
+;;; Pull in various needed bits
+(require :composite-streams)
+(require :sockets)
+(require :winbase)
+(require :lp)
+
+(use-package :gs)
+
+;; MOP stuff
+
+(defclass swank-mop:standard-slot-definition ()
+  ()
+  (:documentation "Dummy class created so that swank.lisp will compile and load."))
+
+(defun named-by-gensym-p (c)
+  (null (symbol-package (class-name c))))
+
+(deftype swank-mop:eql-specializer ()
+  '(satisfies named-by-gensym-p))
+
+(defun swank-mop:eql-specializer-object (specializer)
+  (with-hash-table-iterator (next-entry cl::*clos-singleton-specializers*)
+    (loop (multiple-value-bind (more key value)
+              (next-entry)
+            (unless more (return nil))
+            (when (eq specializer value)
+              (return key))))))
+
+(defun swank-mop:class-finalized-p (class)
+  (declare (ignore class))
+  t)
+
+(defun swank-mop:class-prototype (class)
+  (make-instance class))
+
+(defun swank-mop:specializer-direct-methods (obj)
+  (declare (ignore obj))
+  nil)
+
+(defun swank-mop:generic-function-argument-precedence-order (gf)
+  (generic-function-lambda-list gf))
+
+(defun swank-mop:generic-function-method-combination (gf)
+  (declare (ignore gf))
+  :standard)
+
+(defun swank-mop:generic-function-declarations (gf)
+  (declare (ignore gf))
+  nil)
+
+(defun swank-mop:slot-definition-documentation (slot)
+  (declare (ignore slot))
+  (getf slot :documentation nil))
+
+(defun swank-mop:slot-definition-type (slot)
+  (declare (ignore slot))
+  t)
+
+(import-swank-mop-symbols :cl '(;; classes
+                                :standard-slot-definition
+                                :eql-specializer
+                                :eql-specializer-object
+                                ;; standard class readers
+                                :class-default-initargs
+                                :class-direct-default-initargs
+                                :class-finalized-p
+                                :class-prototype
+                                :specializer-direct-methods
+                                ;; gf readers
+                                :generic-function-argument-precedence-order
+                                :generic-function-declarations
+                                :generic-function-method-combination
+                                ;; method readers
+                                ;; slot readers
+                                :slot-definition-documentation
+                                :slot-definition-type))
+
+;;;; swank implementations
+
+;;; Debugger
+
+(defvar *stack-trace* nil)
+(defvar *frame-trace* nil)
+
+(defstruct frame
+  name function address debug-info variables)
+
+(defimplementation call-with-debugging-environment (fn)
+  (let* ((real-stack-trace (cl::stack-trace))
+         (*stack-trace* (cdr (member 'cl:invoke-debugger real-stack-trace
+                                     :key #'car)))
+         (*frame-trace*
+          (let* ((db::*debug-level*         (1+ db::*debug-level*))
+                 (db::*debug-frame-pointer* (db::stash-ebp
+                                             (ct:create-foreign-ptr)))
+                 (db::*debug-max-level*     (length real-stack-trace))
+                 (db::*debug-min-level*     1))
+            (cdr (member #'cl:invoke-debugger
+                         (cons
+                          (make-frame :function nil)
+                          (loop for i from db::*debug-min-level*
+                             upto db::*debug-max-level*
+                             until (eq (db::get-frame-function i) cl::*top-level*)
+                             collect
+                               (make-frame :function (db::get-frame-function i)
+                                           :address (db::get-frame-address i))))
+                         :key #'frame-function)))))
+    (funcall fn)))
+
+(defimplementation compute-backtrace (start end)
+  (subseq *stack-trace* start (min end (length *stack-trace*))))
+
+(defimplementation print-frame (frame stream)
+  (format stream "~S" frame))
+
+(defun get-frame-debug-info (frame)
+  (or (frame-debug-info frame)
+      (setf (frame-debug-info frame)
+	    (db::prepare-frame-debug-info (frame-function frame)
+					  (frame-address frame)))))
+
+(defimplementation frame-locals (frame-number)
+  (let* ((frame (elt *frame-trace* frame-number))
+         (info (get-frame-debug-info frame)))
+    (let ((var-list
+           (loop for i from 4 below (length info) by 2
+              collect `(list :name ',(svref info i) :id 0
+                             :value (db::debug-filter ,(svref info i))))))
+      (let ((vars (eval-in-frame `(list , at var-list) frame-number)))
+        (setf (frame-variables frame) vars)))))
+
+(defimplementation eval-in-frame (form frame-number)
+  (let ((frame (elt *frame-trace* frame-number)))
+    (let ((cl::*compiler-environment* (get-frame-debug-info frame)))
+      (eval form))))
+
+(defimplementation frame-catch-tags (index)
+  (declare (ignore index))
+  nil)
+
+(defimplementation frame-var-value (frame-number var)
+  (let ((vars (frame-variables (elt *frame-trace* frame-number))))
+    (when vars
+      (second (elt vars var)))))
+
+(defimplementation frame-source-location-for-emacs (frame-number)
+  (fspec-location (frame-function (elt *frame-trace* frame-number))))
+
+(defun break (&optional (format-control "Break") &rest format-arguments)
+  (with-simple-restart (continue "Return from BREAK.")
+    (let ();(*debugger-hook* nil))
+      (let ((condition 
+	     (make-condition 'simple-condition
+			     :format-control format-control
+			     :format-arguments format-arguments)))
+	;;(format *debug-io* ";;; User break: ~A~%" condition)
+	(invoke-debugger condition))))
+  nil)
+
+;;; Socket communication
+
+(defimplementation create-socket (host port)
+  (sockets:start-sockets)
+  (sockets:make-server-socket :host host :port port))
+
+(defimplementation local-port (socket)
+  (sockets:socket-port socket))
+
+(defimplementation close-socket (socket)
+  (close socket))
+
+(defimplementation accept-connection (socket
+				      &key external-format buffering timeout)
+  (declare (ignore buffering timeout external-format))
+  (sockets:make-socket-stream (sockets:accept-socket socket)))
+
+;;; Misc
+
+(defimplementation preferred-communication-style ()
+  nil)
+
+(defimplementation getpid ()
+  ccl:*current-process-id*)
+
+(defimplementation lisp-implementation-type-name ()
+  "cormanlisp")
+
+(defimplementation quit-lisp ()
+  (sockets:stop-sockets)
+  (win32:exitprocess 0))
+
+(defimplementation set-default-directory (directory)
+  (setf (ccl:current-directory) directory)
+  (directory-namestring (setf *default-pathname-defaults* 
+                              (truename (merge-pathnames directory)))))
+
+(defimplementation default-directory ()
+  (directory-namestring (ccl:current-directory)))
+
+(defimplementation macroexpand-all (form)
+  (ccl:macroexpand-all form))
+
+;;; Documentation
+
+(defun fspec-location (fspec)
+  (when (symbolp fspec)
+    (setq fspec (symbol-function fspec)))
+  (let ((file (ccl::function-source-file fspec)))
+    (if file
+        (handler-case
+            (let ((truename (truename
+                             (merge-pathnames file
+                                              ccl:*cormanlisp-directory*))))
+              (make-location (list :file (namestring truename))
+                             (if (ccl::function-source-line fspec)
+                                 (list :line 
+				       (1+ (ccl::function-source-line fspec)))
+                                 (list :function-name (princ-to-string
+                                                       (function-name fspec))))))
+          (error (c) (list :error (princ-to-string c))))
+        (list :error (format nil "No source information available for ~S"
+                             fspec)))))
+
+(defimplementation find-definitions (name)
+  (list (list name (fspec-location name))))
+
+(defimplementation arglist (name)
+  (handler-case
+      (cond ((and (symbolp name)
+                  (macro-function name))
+             (ccl::macro-lambda-list (symbol-function name)))
+            (t
+             (when (symbolp name)
+               (setq name (symbol-function name)))
+             (if (eq (class-of name) cl::the-class-standard-gf)
+                 (generic-function-lambda-list name)
+                 (ccl:function-lambda-list name))))
+    (error () :not-available)))
+
+(defimplementation function-name (fn)
+  (handler-case (getf (cl::function-info-list fn) 'cl::function-name)
+    (error () nil)))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (flet ((doc (kind &optional (sym symbol))
+             (or (documentation sym kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (when (boundp symbol)
+                   (doc 'variable)))
+      (maybe-push
+       :function (if (fboundp symbol)
+                     (doc 'function)))
+      (maybe-push
+       :class (if (find-class symbol nil)
+                  (doc 'class)))
+      result)))
+
+(defimplementation describe-definition (symbol namespace)
+  (ecase namespace
+    (:variable 
+     (describe symbol))
+    ((:function :generic-function)
+     (describe (symbol-function symbol)))
+    (:class
+     (describe (find-class symbol)))))
+
+;;; Compiler 
+
+(defvar *buffer-name* nil)
+(defvar *buffer-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename* nil)
+
+;; FIXME
+(defimplementation call-with-compilation-hooks (FN)
+  (handler-bind ((error (lambda (c)
+                          (signal (make-condition
+                                   'compiler-condition
+                                   :original-condition c
+                                   :severity :warning
+                                   :message (format nil "~A" c)
+                                   :location
+                                   (cond (*buffer-name*
+                                          (make-location
+                                           (list :buffer *buffer-name*)
+                                           (list :position *buffer-position*)))
+                                         (*compile-filename*
+                                          (make-location
+                                           (list :file *compile-filename*)
+                                           (list :position 1)))
+                                         (t
+                                          (list :error "No location"))))))))
+    (funcall fn)))
+
+(defimplementation swank-compile-file (*compile-filename* load-p
+				       external-format)
+  (declare (ignore external-format))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* nil))
+      (compile-file *compile-filename*)
+      (when load-p
+        (load (compile-file-pathname *compile-filename*))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-position* position)
+          (*buffer-string* string))
+      (funcall (compile nil (read-from-string
+                             (format nil "(~S () ~A)" 'lambda string)))))))
+
+;;;; Inspecting
+
+;; Hack to make swank.lisp load, at least
+(defclass file-stream ())
+
+(defclass corman-inspector (backend-inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'corman-inspector))
+
+(defun comma-separated (list &optional (callback (lambda (v)
+                                                   `(:value ,v))))
+  (butlast (loop for e in list
+              collect (funcall callback e)
+              collect ", ")))
+
+(defmethod inspect-for-emacs ((class standard-class)
+                              (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values "A class."
+          `("Name: " (:value ,(class-name class))
+            (:newline)
+            "Super classes: "
+            ,@(comma-separated (swank-mop:class-direct-superclasses class))
+            (:newline)
+            "Direct Slots: "
+            ,@(comma-separated
+               (swank-mop:class-direct-slots class)
+               (lambda (slot)
+                 `(:value ,slot ,(princ-to-string (swank-mop:slot-definition-name slot)))))
+            (:newline)
+            "Effective Slots: "
+            ,@(if (swank-mop:class-finalized-p class)
+                  (comma-separated
+                   (swank-mop:class-slots class)
+                   (lambda (slot)
+                     `(:value ,slot ,(princ-to-string
+                                      (swank-mop:slot-definition-name slot)))))
+                  '("#<N/A (class not finalized)>"))
+            (:newline)
+            ,@(when (documentation class t)
+                `("Documentation:" (:newline) ,(documentation class t) (:newline)))
+            "Sub classes: "
+            ,@(comma-separated (swank-mop:class-direct-subclasses class)
+                               (lambda (sub)
+                                 `(:value ,sub ,(princ-to-string (class-name sub)))))
+            (:newline)
+            "Precedence List: "
+            ,@(if (swank-mop:class-finalized-p class)
+                  (comma-separated (swank-mop:class-precedence-list class)
+                                         (lambda (class)
+                                           `(:value ,class ,(princ-to-string (class-name class)))))
+                  '("#<N/A (class not finalized)>"))
+            (:newline))))
+
+(defmethod inspect-for-emacs ((slot cons) (inspector backend-inspector))
+  ;; Inspects slot definitions
+  (declare (ignore inspector))
+  (if (eq (car slot) :name)
+      (values "A slot." 
+              `("Name: " (:value ,(swank-mop:slot-definition-name slot))
+                         (:newline)
+                         ,@(when (swank-mop:slot-definition-documentation slot)
+                             `("Documentation:"  (:newline)
+                                                 (:value ,(swank-mop:slot-definition-documentation slot))
+                                                 (:newline)))
+                         "Init args: " (:value ,(swank-mop:slot-definition-initargs slot)) (:newline)
+                         "Init form: "  ,(if (swank-mop:slot-definition-initfunction slot)
+                                             `(:value ,(swank-mop:slot-definition-initform slot))
+                                             "#<unspecified>") (:newline)
+                                             "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot))
+                                             (:newline)))
+      (call-next-method)))
+  
+(defmethod inspect-for-emacs ((pathname pathnames::pathname-internal)
+                              inspector)
+  (declare (ignore inspector))
+  (values (if (wild-pathname-p pathname)
+              "A wild pathname."
+              "A pathname.")
+          (append (label-value-line*
+                   ("Namestring" (namestring pathname))
+                   ("Host"       (pathname-host pathname))
+                   ("Device"     (pathname-device pathname))
+                   ("Directory"  (pathname-directory pathname))
+                   ("Name"       (pathname-name pathname))
+                   ("Type"       (pathname-type pathname))
+                   ("Version"    (pathname-version pathname)))
+                  (unless (or (wild-pathname-p pathname)
+                              (not (probe-file pathname)))
+                    (label-value-line "Truename" (truename pathname))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (cond ((cl::structurep o) (inspect-structure o))
+	(t (call-next-method))))
+
+(defun inspect-structure (o)
+  (values 
+   (format nil "~A is a structure" o)
+   (let* ((template (cl::uref o 1))
+	  (num-slots (cl::struct-template-num-slots template)))
+     (cond ((symbolp template)
+	    (loop for i below num-slots
+		  append (label-value-line i (cl::uref o (+ 2 i)))))
+	   (t
+	    (loop for i below num-slots
+		  append (label-value-line (elt template (+ 6 (* i 5)))
+					   (cl::uref o (+ 2 i)))))))))
+
+
+;;; Threads
+
+(require 'threads)
+
+(defstruct (mailbox (:conc-name mailbox.)) 
+  thread
+  (lock (make-instance 'threads:critical-section))
+  (queue '() :type list))
+
+(defvar *mailbox-lock* (make-instance 'threads:critical-section))
+(defvar *mailboxes* (list))
+
+(defmacro with-lock  (lock &body body)
+  `(threads:with-synchronization (threads:cs ,lock)
+    , at body))
+
+(defimplementation spawn (fun &key name)
+  (declare (ignore name))
+  (th:create-thread 
+   (lambda ()
+     (handler-bind ((serious-condition #'invoke-debugger))
+       (unwind-protect (funcall fun)
+	 (with-lock *mailbox-lock*
+	   (setq *mailboxes* (remove cormanlisp:*current-thread-id*
+				     *mailboxes* :key #'mailbox.thread))))))))
+
+(defimplementation thread-id (thread)
+  thread)
+
+(defimplementation find-thread (thread)
+  (if (thread-alive-p thread)
+      thread))
+
+(defimplementation thread-alive-p (thread)
+  (if (threads:thread-handle thread) t nil))
+
+(defimplementation current-thread ()
+  cormanlisp:*current-thread-id*)
+
+;; XXX implement it
+(defimplementation all-threads ()
+  '())
+
+;; XXX something here is broken
+(defimplementation kill-thread (thread)
+  (threads:terminate-thread thread 'killed))
+
+(defun mailbox (thread)
+  (with-lock *mailbox-lock*
+    (or (find thread *mailboxes* :key #'mailbox.thread)
+	(let ((mb (make-mailbox :thread thread)))
+	  (push mb *mailboxes*)
+	  mb))))
+
+(defimplementation send (thread message)
+  (let ((mbox (mailbox thread)))
+    (with-lock (mailbox.lock mbox)
+      (setf (mailbox.queue mbox)
+	    (nconc (mailbox.queue mbox) (list message))))))
+
+(defimplementation receive ()
+  (let ((mbox (mailbox cormanlisp:*current-thread-id*)))
+    (loop 
+     (with-lock (mailbox.lock mbox)
+       (when (mailbox.queue mbox)
+	 (return (pop (mailbox.queue mbox)))))
+     (sleep 0.1))))
+
+
+;;; This is probably not good, but it WFM
+(in-package :common-lisp)
+
+(defvar *old-documentation* #'documentation)
+(defun documentation (thing &optional (type 'function))
+  (if (symbolp thing)
+      (funcall *old-documentation* thing type)
+      (values)))
+
+(defmethod print-object ((restart restart) stream)
+  (if (or *print-escape*
+          *print-readably*)
+      (print-unreadable-object (restart stream :type t :identity t)
+        (princ (restart-name restart) stream))
+      (when (functionp (restart-report-function restart))
+        (funcall (restart-report-function restart) stream))))

Added: branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,246 @@
+;;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-ecl.lisp --- SLIME backend for ECL.
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;
+
+;;; Administrivia
+
+(in-package :swank-backend)
+
+(import-from :ext *gray-stream-symbols* :swank-backend)
+
+(swank-backend::import-swank-mop-symbols :clos
+ '(:eql-specializer
+   :eql-specializer-object
+   :generic-function-declarations
+   :specializer-direct-methods
+   :compute-applicable-methods-using-classes))
+
+
+;;;; TCP Server
+
+(require 'sockets)
+
+(defun resolve-hostname (name)
+  (car (sb-bsd-sockets:host-ent-addresses
+        (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port)
+  (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+			       :type :stream
+			       :protocol :tcp)))
+    (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+    (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+    (sb-bsd-sockets:socket-listen socket 5)
+    socket))
+
+(defimplementation local-port (socket)
+  (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+  (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket
+                                      &key external-format
+                                      buffering timeout)
+  (declare (ignore buffering timeout external-format))
+  (make-socket-io-stream (accept socket)))
+
+(defun make-socket-io-stream (socket)
+  (sb-bsd-sockets:socket-make-stream socket
+                                     :output t
+                                     :input t
+                                     :element-type 'base-char))
+
+(defun accept (socket)
+  "Like socket-accept, but retry on EAGAIN."
+  (loop (handler-case
+            (return (sb-bsd-sockets:socket-accept socket))
+          (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation preferred-communication-style ()
+  (values nil))
+
+
+;;;; Unix signals
+
+(defimplementation getpid ()
+  (si:getpid))
+
+#+nil
+(defimplementation set-default-directory (directory)
+  (ext::chdir (namestring directory))
+  ;; Setting *default-pathname-defaults* to an absolute directory
+  ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+  (setf *default-pathname-defaults* (ext::getcwd))
+  (default-directory))
+
+#+nil
+(defimplementation default-directory ()
+  (namestring (ext:getcwd)))
+
+(defimplementation quit-lisp ()
+  (ext:quit))
+
+
+;;;; Compilation
+
+(defvar *buffer-name* nil)
+(defvar *buffer-start-position*)
+(defvar *buffer-string*)
+(defvar *compile-filename*)
+
+(defun signal-compiler-condition (&rest args)
+  (signal (apply #'make-condition 'compiler-condition args)))
+
+(defun handle-compiler-warning (condition)
+  (signal-compiler-condition
+   :original-condition condition
+   :message (format nil "~A" condition)
+   :severity :warning
+   :location
+   (if *buffer-name*
+       (make-location (list :buffer *buffer-name*)
+                      (list :position *buffer-start-position*))
+       ;; ;; compiler::*current-form*
+       ;; (if compiler::*current-function*
+       ;;     (make-location (list :file *compile-filename*)
+       ;;                    (list :function-name   
+       ;;                          (symbol-name
+       ;;                           (slot-value compiler::*current-function*
+       ;;                                       'compiler::name))))
+       (list :error "No location found.")
+           ;; )
+       )))
+
+(defimplementation call-with-compilation-hooks (function)
+  (handler-bind ((warning #'handle-compiler-warning))
+    (funcall function)))
+
+(defimplementation swank-compile-file (*compile-filename* load-p
+                                       external-format)
+  (declare (ignore external-format))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* nil))
+      (multiple-value-bind (fn warn fail) 
+          (compile-file *compile-filename*)
+        (when load-p (unless fail (load fn)))))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-start-position* position)
+          (*buffer-string* string))
+      (with-input-from-string (s string)
+        (compile-from-stream s :load t)))))
+
+(defun compile-from-stream (stream &rest args)
+  (let ((file (si::mkstemp "TMP:ECLXXXXXX")))
+    (with-open-file (s file :direction :output :if-exists :overwrite)
+      (do ((line (read-line stream nil) (read-line stream nil)))
+	  ((not line))
+	(write-line line s)))
+    (unwind-protect
+         (apply #'compile-file file args)
+      (delete-file file))))
+
+
+;;;; Documentation
+
+(defimplementation arglist (name)
+  (or (functionp name) (setf name (symbol-function name)))
+  (if (functionp name)
+      (typecase name 
+        (generic-function
+         (clos::generic-function-lambda-list name))
+        (function
+         (let ((fle (function-lambda-expression name)))
+           (case (car fle)
+             (si:lambda-block (caddr fle))
+             (t               :not-available)))))
+      :not-available))
+
+(defimplementation function-name (f)
+  (si:compiled-function-name f))
+
+(defimplementation macroexpand-all (form)
+  ;;; FIXME! This is not the same as a recursive macroexpansion!
+  (macroexpand form))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (dolist (type '(:VARIABLE :FUNCTION :CLASS))
+      (let ((doc (describe-definition symbol type)))
+        (when doc
+          (setf result (list* type doc result)))))
+    result))
+
+(defimplementation describe-definition (name type)
+  (case type
+    (:variable (documentation name 'variable))
+    (:function (documentation name 'function))
+    (:class (documentation name 'class))
+    (t nil)))
+
+;;; Debugging
+
+(import
+ '(si::*ihs-top*
+   si::*ihs-current*
+   si::*ihs-base*
+   si::*frs-base*
+   si::*frs-top*
+   si::*tpl-commands*
+   si::*tpl-level*
+   si::frs-top
+   si::ihs-top
+   si::sch-frs-base
+   si::set-break-env
+   si::set-current-ihs
+   si::tpl-commands))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (declare (type function debugger-loop-fn))
+  (let* ((*tpl-commands* si::tpl-commands)
+         (*ihs-top* (ihs-top 'call-with-debugging-environment))
+	 (*ihs-current* *ihs-top*)
+	 (*frs-base* (or (sch-frs-base *frs-top* *ihs-base*) (1+ (frs-top))))
+	 (*frs-top* (frs-top))
+	 (*read-suppress* nil)
+	 (*tpl-level* (1+ *tpl-level*)))
+    (set-break-env)
+    (set-current-ihs)
+    (funcall debugger-loop-fn)))
+
+;; (defimplementation call-with-debugger-hook (hook fun)
+;;   (let ((*debugger-hook* hook))
+;;     (funcall fun)))
+
+(defun nth-frame (n)
+  (cond ((>= n *ihs-top* ) nil)
+        (t (- *ihs-top*  n))))
+                                               
+(defimplementation compute-backtrace (start end)
+  (loop for i from start below end
+        for f = (nth-frame i)     
+        while f
+        collect f))
+
+(defimplementation print-frame (frame stream)
+  (format stream "~A" (si::ihs-fname frame)))
+
+;;;; Inspector
+
+(defclass ecl-inspector (inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'ecl-inspector))
+
+;;;; Definitions
+
+(defimplementation find-definitions (name) nil)

Added: branches/trunk-reorg/thirdparty/slime/swank-gray.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-gray.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-gray.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,168 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-gray.lisp --- Gray stream based IO redirection.
+;;;
+;;; Created 2003
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+(defclass slime-output-stream (fundamental-character-output-stream)
+  ((output-fn :initarg :output-fn)
+   (buffer :initform (make-string 8000))
+   (fill-pointer :initform 0)
+   (column :initform 0)
+   (last-flush-time :initform (get-internal-real-time))
+   (lock :initform (make-recursive-lock :name "buffer write lock"))))
+
+(defmethod stream-write-char ((stream slime-output-stream) char)
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (buffer fill-pointer column) stream
+       (setf (schar buffer fill-pointer) char)
+       (incf fill-pointer)
+       (incf column)
+       (when (char= #\newline char)
+         (setf column 0)
+         (force-output stream))
+       (when (= fill-pointer (length buffer))
+         (finish-output stream)))))
+  char)
+
+(defmethod stream-line-column ((stream slime-output-stream))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (slot-value stream 'column))))
+
+(defmethod stream-line-length ((stream slime-output-stream))
+  75)
+
+(defmethod stream-finish-output ((stream slime-output-stream))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (buffer fill-pointer output-fn last-flush-time) stream
+       (let ((end fill-pointer))
+         (unless (zerop end)
+           (funcall output-fn (subseq buffer 0 end))
+           (setf fill-pointer 0)))
+       (setf last-flush-time (get-internal-real-time)))))
+  nil)
+
+(defmethod stream-force-output ((stream slime-output-stream))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (last-flush-time fill-pointer) stream
+       (let ((now (get-internal-real-time)))
+         (when (> (/ (- now last-flush-time)
+                     (coerce internal-time-units-per-second 'double-float))
+                  0.2)
+           (finish-output stream))))))
+  nil)
+
+(defmethod stream-fresh-line ((stream slime-output-stream))
+  (call-with-recursive-lock-held
+   (slot-value stream 'lock)
+   (lambda ()
+     (with-slots (column) stream
+       (cond ((zerop column) nil)
+             (t (terpri stream) t))))))
+
+(defclass slime-input-stream (fundamental-character-input-stream)
+  ((output-stream :initarg :output-stream)
+   (input-fn :initarg :input-fn)
+   (buffer :initform "") (index :initform 0)
+   (lock :initform (make-lock :name "buffer read lock"))))
+
+(defmethod stream-read-char ((s slime-input-stream))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index output-stream input-fn) s
+       (when (= index (length buffer))
+         (when output-stream
+           (finish-output output-stream))
+         (let ((string (funcall input-fn)))
+           (cond ((zerop (length string))
+                  (return-from stream-read-char :eof))
+                 (t
+                  (setf buffer string)
+                  (setf index 0)))))
+       (assert (plusp (length buffer)))
+       (prog1 (aref buffer index) (incf index))))))
+
+(defmethod stream-listen ((s slime-input-stream))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s
+       (< index (length buffer))))))
+
+(defmethod stream-unread-char ((s slime-input-stream) char)
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s
+       (decf index)
+       (cond ((eql (aref buffer index) char)
+              (setf (aref buffer index) char))
+             (t
+              (warn "stream-unread-char: ignoring ~S (expected ~S)"
+                    char (aref buffer index)))))))
+  nil)
+
+(defmethod stream-clear-input ((s slime-input-stream))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s 
+       (setf buffer ""  
+             index 0))))
+  nil)
+
+(defmethod stream-line-column ((s slime-input-stream))
+  nil)
+
+(defmethod stream-line-length ((s slime-input-stream))
+  75)
+
+
+;;; CLISP extensions
+
+;; We have to define an additional method for the sake of the C
+;; function listen_char (see src/stream.d), on which SYS::READ-FORM
+;; depends.
+
+;; We could make do with either of the two methods below.
+
+(defmethod stream-read-char-no-hang ((s slime-input-stream))
+  (call-with-lock-held
+   (slot-value s 'lock)
+   (lambda ()
+     (with-slots (buffer index) s
+       (when (< index (length buffer))
+         (prog1 (aref buffer index) (incf index)))))))
+
+;; This CLISP extension is what listen_char actually calls.  The
+;; default method would call STREAM-READ-CHAR-NO-HANG, so it is a bit
+;; more efficient to define it directly.
+
+(defmethod stream-read-char-will-hang-p ((s slime-input-stream))
+  (with-slots (buffer index) s
+    (= index (length buffer))))
+
+
+;;;
+(defimplementation make-fn-streams (input-fn output-fn)
+  (let* ((output (make-instance 'slime-output-stream 
+                                :output-fn output-fn))
+         (input  (make-instance 'slime-input-stream
+                                :input-fn input-fn 
+                                :output-stream output)))
+    (values input output)))
\ No newline at end of file

Added: branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,803 @@
+;;; -*- indent-tabs-mode: nil -*-
+;;;
+;;; swank-lispworks.lisp --- LispWorks specific code for SLIME. 
+;;;
+;;; Created 2003, Helmut Eller
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require "comm")
+  (import-from :stream *gray-stream-symbols* :swank-backend))
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation
+                                  :eql-specializer
+                                  :eql-specializer-object
+                                  :compute-applicable-methods-using-classes))
+
+(defun swank-mop:slot-definition-documentation (slot)
+  (documentation slot t))
+
+(defun swank-mop:compute-applicable-methods-using-classes (gf classes)
+  (clos::compute-applicable-methods-from-classes gf classes))
+
+;; lispworks doesn't have the eql-specializer class, it represents
+;; them as a list of `(EQL ,OBJECT)
+(deftype swank-mop:eql-specializer () 'cons)
+
+(defun swank-mop:eql-specializer-object (eql-spec)
+  (second eql-spec))
+
+(when (fboundp 'dspec::define-dspec-alias)
+  (dspec::define-dspec-alias defimplementation (name args &rest body)
+    `(defmethod ,name ,args , at body)))
+
+;;; TCP server
+
+(defimplementation preferred-communication-style ()
+  :spawn)
+
+(defun socket-fd (socket)
+  (etypecase socket
+    (fixnum socket)
+    (comm:socket-stream (comm:socket-stream-socket socket))))
+
+(defimplementation create-socket (host port)
+  (multiple-value-bind (socket where errno)
+      #-(or lispworks4.1 (and macosx lispworks4.3))
+      (comm::create-tcp-socket-for-service port :address host)
+      #+(or lispworks4.1 (and macosx lispworks4.3))
+      (comm::create-tcp-socket-for-service port)
+    (cond (socket socket)
+          (t (error 'network-error 
+              :format-control "~A failed: ~A (~D)"
+              :format-arguments (list where 
+                                      (list #+unix (lw:get-unix-error errno))
+                                      errno))))))
+
+(defimplementation local-port (socket)
+  (nth-value 1 (comm:get-socket-address (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+  (comm::close-socket (socket-fd socket)))
+
+(defimplementation accept-connection (socket 
+                                      &key external-format buffering timeout)
+  (declare (ignore buffering timeout external-format))
+  (let* ((fd (comm::get-fd-from-socket socket)))
+    (assert (/= fd -1))
+    (make-instance 'comm:socket-stream :socket fd :direction :io 
+                   :element-type 'base-char)))
+
+(defun set-sigint-handler ()
+  ;; Set SIGINT handler on Swank request handler thread.
+  #-win32
+  (sys::set-signal-handler +sigint+ 
+                           (make-sigint-handler mp:*current-process*)))
+
+;;; Coding Systems
+
+(defvar *external-format-to-coding-system*
+  '(((:latin-1 :eol-style :lf) 
+     "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
+    ((:latin-1) 
+     "latin-1" "iso-latin-1" "iso-8859-1")
+    ((:utf-8) "utf-8")
+    ((:utf-8 :eol-style :lf) "utf-8-unix")
+    ((:euc-jp) "euc-jp")
+    ((:euc-jp :eol-style :lf) "euc-jp-unix")
+    ((:ascii) "us-ascii")
+    ((:ascii :eol-style :lf) "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
+
+;;; Unix signals
+
+(defun sigint-handler ()
+  (with-simple-restart  (continue "Continue from SIGINT handler.")
+    (invoke-debugger "SIGINT")))
+
+(defun make-sigint-handler (process)
+  (lambda (&rest args)
+    (declare (ignore args))
+    (mp:process-interrupt process #'sigint-handler)))
+
+(defimplementation call-without-interrupts (fn)
+  (lw:without-interrupts (funcall fn)))
+  
+(defimplementation getpid ()
+  #+win32 (win32:get-current-process-id)
+  #-win32 (system::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  "lispworks")
+
+(defimplementation set-default-directory (directory)
+  (namestring (hcl:change-directory directory)))
+
+;;;; Documentation
+
+(defimplementation arglist (symbol-or-function)
+  (let ((arglist (lw:function-lambda-list symbol-or-function)))
+    (etypecase arglist
+      ((member :dont-know) 
+       :not-available)
+      (list
+       arglist))))
+
+(defimplementation function-name (function)
+  (nth-value 2 (function-lambda-expression function)))
+
+(defimplementation macroexpand-all (form)
+  (walker:walk-form form))
+
+(defun generic-function-p (object)
+  (typep object 'generic-function))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+  (let ((result '()))
+    (labels ((first-line (string) 
+               (let ((pos (position #\newline string)))
+                 (if (null pos) string (subseq string 0 pos))))
+             (doc (kind &optional (sym symbol))
+               (let ((string (documentation sym kind)))
+                 (if string 
+                     (first-line string)
+                     :not-documented)))
+             (maybe-push (property value)
+               (when value
+                 (setf result (list* property value result)))))
+      (maybe-push
+       :variable (when (boundp symbol)
+                   (doc 'variable)))
+      (maybe-push
+       :generic-function (if (and (fboundp symbol)
+                                  (generic-function-p (fdefinition symbol)))
+                             (doc 'function)))
+      (maybe-push
+       :function (if (and (fboundp symbol)
+                          (not (generic-function-p (fdefinition symbol))))
+                     (doc 'function)))
+      (maybe-push
+       :setf (let ((setf-name (sys:underlying-setf-name `(setf ,symbol))))
+               (if (fboundp setf-name)
+                   (doc 'setf))))
+      (maybe-push
+       :class (if (find-class symbol nil) 
+                  (doc 'class)))
+      result)))
+
+(defimplementation describe-definition (symbol type)
+  (ecase type
+    (:variable (describe-symbol symbol))
+    (:class (describe (find-class symbol)))
+    ((:function :generic-function) (describe-function symbol))
+    (:setf (describe-function (sys:underlying-setf-name `(setf ,symbol))))))
+
+(defun describe-function (symbol)
+  (cond ((fboundp symbol)
+         (format t "~%(~A~{ ~A~})~%~%~:[(not documented)~;~:*~A~]~%"
+                 (string-downcase symbol)
+                 (mapcar #'string-upcase 
+                         (lispworks:function-lambda-list symbol))
+                 (documentation symbol 'function))
+         (describe (fdefinition symbol)))
+        (t (format t "~S is not fbound" symbol))))
+
+(defun describe-symbol (sym)
+  (format t "~A is a symbol in package ~A." sym (symbol-package sym))
+  (when (boundp sym)
+    (format t "~%~%Value: ~A" (symbol-value sym)))
+  (let ((doc (documentation sym 'variable)))
+    (when doc 
+      (format t "~%~%Variable documentation:~%~A"  doc)))
+  (when (fboundp sym)
+    (describe-function sym)))
+
+;;; Debugging
+
+(defclass slime-env (env:environment) 
+  ((debugger-hook :initarg :debugger-hoook)))
+
+(defun slime-env (hook io-bindings) 
+  (make-instance 'slime-env :name "SLIME Environment" 
+                 :io-bindings io-bindings
+                 :debugger-hoook hook))
+
+(defmethod env-internals:environment-display-notifier
+    ((env slime-env) &key restarts condition)
+  (declare (ignore restarts))
+  (funcall (slot-value env 'debugger-hook) condition *debugger-hook*))
+
+(defmethod env-internals:environment-display-debugger ((env slime-env))
+  *debug-io*)
+
+(defimplementation call-with-debugger-hook (hook fun)
+  (let ((*debugger-hook* hook))
+    (env:with-environment ((slime-env hook '()))
+      (funcall fun))))
+
+(defvar *sldb-top-frame*)
+
+(defun interesting-frame-p (frame)
+  (cond ((or (dbg::call-frame-p frame)
+             (dbg::derived-call-frame-p frame)
+             (dbg::foreign-frame-p frame)
+             (dbg::interpreted-call-frame-p frame))
+         t)
+        ((dbg::catch-frame-p frame) dbg:*print-catch-frames*)
+        ((dbg::binding-frame-p frame) dbg:*print-binding-frames*)
+        ((dbg::handler-frame-p frame) dbg:*print-handler-frames*)
+        ((dbg::restart-frame-p frame) dbg:*print-restart-frames*)
+        ((dbg::open-frame-p frame) dbg:*print-open-frames*)
+        (t nil)))
+
+(defun nth-next-frame (frame n)
+  "Unwind FRAME N times."
+  (do ((frame frame (dbg::frame-next frame))
+       (i n (if (interesting-frame-p frame) (1- i) i)))
+      ((or (not frame)
+           (and (interesting-frame-p frame) (zerop i)))
+       frame)))
+
+(defun nth-frame (index)
+  (nth-next-frame *sldb-top-frame* index))
+           
+(defun find-top-frame ()
+  "Return the most suitable top-frame for the debugger."
+  (or (do ((frame (dbg::debugger-stack-current-frame dbg::*debugger-stack*)
+                  (nth-next-frame frame 1)))
+          ((or (null frame)             ; no frame found!
+               (and (dbg::call-frame-p frame)
+                    (eq (dbg::call-frame-function-name frame) 
+                        'invoke-debugger)))
+           (nth-next-frame frame 1)))
+      ;; if we can't find a invoke-debugger frame, take any old frame at the top
+      (dbg::debugger-stack-current-frame dbg::*debugger-stack*)))
+  
+(defimplementation call-with-debugging-environment (fn)
+  (dbg::with-debugger-stack ()
+    (let ((*sldb-top-frame* (find-top-frame)))
+      (funcall fn))))
+
+(defimplementation compute-backtrace (start end)
+  (let ((end (or end most-positive-fixnum))
+	(backtrace '()))
+    (do ((frame (nth-frame start) (dbg::frame-next frame))
+	 (i start))
+	((or (not frame) (= i end)) (nreverse backtrace))
+      (when (interesting-frame-p frame)
+	(incf i)
+	(push frame backtrace)))))
+
+(defun frame-actual-args (frame)
+  (let ((*break-on-signals* nil))
+    (mapcar (lambda (arg)
+              (case arg
+                ((&rest &optional &key) arg)
+                (t
+                 (handler-case (dbg::dbg-eval arg frame)
+                   (error (e) (format nil "<~A>" arg))))))
+            (dbg::call-frame-arglist frame))))
+
+(defimplementation print-frame (frame stream)
+  (cond ((dbg::call-frame-p frame)
+         (format stream "~S ~S"
+                 (dbg::call-frame-function-name frame)
+                 (frame-actual-args frame)))
+        (t (princ frame stream))))
+
+(defun frame-vars (frame)
+  (first (dbg::frame-locals-format-list frame #'list 75 0)))
+
+(defimplementation frame-locals (n)
+  (let ((frame (nth-frame n)))
+    (if (dbg::call-frame-p frame)
+        (mapcar (lambda (var)
+                  (destructuring-bind (name value symbol location) var
+                    (declare (ignore name location))
+                    (list :name symbol :id 0
+                          :value value)))
+                (frame-vars frame)))))
+
+(defimplementation frame-var-value (frame var)
+  (let ((frame (nth-frame frame)))
+    (destructuring-bind (_n value _s _l) (nth var (frame-vars frame))
+      (declare (ignore _n _s _l))
+      value)))
+
+(defimplementation frame-catch-tags (index)
+  (declare (ignore index))
+  nil)
+
+(defimplementation frame-source-location-for-emacs (frame)
+  (let ((frame (nth-frame frame))
+        (callee (if (plusp frame) (nth-frame (1- frame)))))
+    (if (dbg::call-frame-p frame)
+	(let ((dspec (dbg::call-frame-function-name frame))
+              (cname (and (dbg::call-frame-p callee)
+                          (dbg::call-frame-function-name callee))))
+	  (if dspec
+              (frame-location dspec cname))))))
+
+(defimplementation eval-in-frame (form frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (dbg::dbg-eval form frame)))
+
+(defimplementation return-from-frame (frame-number form)
+  (let* ((frame (nth-frame frame-number))
+         (return-frame (dbg::find-frame-for-return frame)))
+    (dbg::dbg-return-from-call-frame frame form return-frame 
+                                     dbg::*debugger-stack*)))
+
+(defimplementation restart-frame (frame-number)
+  (let ((frame (nth-frame frame-number)))
+    (dbg::restart-frame frame :same-args t)))
+
+;;; Definition finding
+
+(defun frame-location (dspec callee-name)
+  (let ((infos (dspec:find-dspec-locations dspec)))
+    (cond (infos 
+           (destructuring-bind ((rdspec location) &rest _) infos
+             (declare (ignore _))
+             (let ((name (and callee-name (symbolp callee-name)
+                              (string callee-name))))
+               (make-dspec-location rdspec location 
+                                    `(:call-site ,name)))))
+          (t 
+           (list :error (format nil "Source location not available for: ~S" 
+                                dspec))))))
+
+(defimplementation find-definitions (name)
+  (let ((locations (dspec:find-name-locations dspec:*dspec-classes* name)))
+    (loop for (dspec location) in locations
+          collect (list dspec (make-dspec-location dspec location)))))
+
+
+;;; Compilation 
+
+(defmacro with-swank-compilation-unit ((location &rest options) &body body)
+  (lw:rebinding (location)
+    `(let ((compiler::*error-database* '()))
+       (with-compilation-unit ,options
+         , at body
+         (signal-error-data-base compiler::*error-database* ,location)
+         (signal-undefined-functions compiler::*unknown-functions* ,location)))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (with-swank-compilation-unit (filename)
+    (compile-file filename :load load-p :external-format external-format)))
+
+(defvar *within-call-with-compilation-hooks* nil
+  "Whether COMPILE-FILE was called from within CALL-WITH-COMPILATION-HOOKS.")
+
+(defvar *undefined-functions-hash* nil
+  "Hash table to map info about undefined functions to pathnames.")
+
+(lw:defadvice (compile-file compile-file-and-collect-notes :around)
+    (pathname &rest rest)
+  (multiple-value-prog1 (apply #'lw:call-next-advice pathname rest)
+    (when *within-call-with-compilation-hooks*
+      (maphash (lambda (unfun dspecs)
+                 (dolist (dspec dspecs)
+                   (let ((unfun-info (list unfun dspec)))
+                     (unless (gethash unfun-info *undefined-functions-hash*)
+                       (setf (gethash unfun-info *undefined-functions-hash*)
+                               pathname)))))
+               compiler::*unknown-functions*))))
+
+(defimplementation call-with-compilation-hooks (function)
+  (let ((compiler::*error-database* '())
+        (*undefined-functions-hash* (make-hash-table :test 'equal))
+        (*within-call-with-compilation-hooks* t))
+    (with-compilation-unit ()
+      (prog1 (funcall function)
+        (signal-error-data-base compiler::*error-database*)
+        (signal-undefined-functions compiler::*unknown-functions*)))))
+
+(defun map-error-database (database fn)
+  (loop for (filename . defs) in database do
+	(loop for (dspec . conditions) in defs do
+	      (dolist (c conditions) 
+		(funcall fn filename dspec c)))))
+
+(defun lispworks-severity (condition)
+  (cond ((not condition) :warning)
+	(t (etypecase condition
+	     (error :error)
+	     (style-warning :warning)
+	     (warning :warning)))))
+
+(defun signal-compiler-condition (message location condition)
+  (check-type message string)
+  (signal 
+   (make-instance 'compiler-condition :message message 
+		  :severity (lispworks-severity condition) 
+		  :location location
+		  :original-condition condition)))
+
+(defun compile-from-temp-file (string filename)
+  (unwind-protect
+       (progn
+	 (with-open-file (s filename :direction :output :if-exists :supersede)
+	   (write-string string s)
+	   (finish-output s))
+	 (let ((binary-filename (compile-file filename :load t)))
+           (when binary-filename
+             (delete-file binary-filename))))
+    (delete-file filename)))
+
+(defun dspec-buffer-position (dspec offset)
+  (etypecase dspec
+    (cons (let ((name (dspec:dspec-primary-name dspec)))
+            (typecase name
+              ((or symbol string) 
+               (list :function-name (string name)))
+              (t (list :position offset)))))
+    (null (list :position offset))
+    (symbol (list :function-name (string dspec)))))
+
+(defmacro with-fairly-standard-io-syntax (&body body)
+  "Like WITH-STANDARD-IO-SYNTAX but preserve *PACKAGE* and *READTABLE*."
+  (let ((package (gensym))
+        (readtable (gensym)))
+    `(let ((,package *package*)
+           (,readtable *readtable*))
+      (with-standard-io-syntax
+        (let ((*package* ,package)
+              (*readtable* ,readtable))
+          , at body)))))
+
+#-(or lispworks4.1 lispworks4.2) ; no dspec:parse-form-dspec prior to 4.3
+(defun dspec-stream-position (stream dspec)
+  (with-fairly-standard-io-syntax
+    (loop (let* ((pos (file-position stream))
+                 (form (read stream nil '#1=#:eof)))
+            (when (eq form '#1#)
+              (return nil))
+            (labels ((check-dspec (form)
+                       (when (consp form)
+                         (let ((operator (car form)))
+                           (case operator
+                             ((progn)
+                              (mapcar #'check-dspec
+                                      (cdr form)))
+                             ((eval-when locally macrolet symbol-macrolet)
+                              (mapcar #'check-dspec
+                                      (cddr form)))
+                             ((in-package)
+                              (let ((package (find-package (second form))))
+                                (when package
+                                  (setq *package* package))))
+                             (otherwise
+                              (let ((form-dspec (dspec:parse-form-dspec form)))
+                                (when (dspec:dspec-equal dspec form-dspec)
+                                  (return pos)))))))))
+              (check-dspec form))))))
+
+(defun dspec-file-position (file dspec)
+  (let* ((*compile-file-pathname* (pathname file))
+         (*compile-file-truename* (truename *compile-file-pathname*))
+         (*load-pathname* *compile-file-pathname*)
+         (*load-truename* *compile-file-truename*))
+    (with-open-file (stream file)
+      (let ((pos 
+             #-(or lispworks4.1 lispworks4.2)
+             (dspec-stream-position stream dspec)))
+        (if pos
+            (list :position (1+ pos) t)
+            (dspec-buffer-position dspec 1))))))
+
+(defun emacs-buffer-location-p (location)
+  (and (consp location)
+       (eq (car location) :emacs-buffer)))
+
+(defun make-dspec-location (dspec location &optional hints)
+  (etypecase location
+    ((or pathname string)
+     (multiple-value-bind (file err) 
+         (ignore-errors (namestring (truename location)))
+       (if err
+           (list :error (princ-to-string err))
+           (make-location `(:file ,file)
+                          (dspec-file-position file dspec)
+                          hints))))
+    (symbol 
+     `(:error ,(format nil "Cannot resolve location: ~S" location)))
+    ((satisfies emacs-buffer-location-p)
+     (destructuring-bind (_ buffer offset string) location
+       (declare (ignore _ string))
+       (make-location `(:buffer ,buffer)
+                      (dspec-buffer-position dspec offset)
+                      hints)))))
+
+(defun make-dspec-progenitor-location (dspec location)
+  (let ((canon-dspec (dspec:canonicalize-dspec dspec)))
+    (make-dspec-location
+     (if canon-dspec
+         (if (dspec:local-dspec-p canon-dspec)
+             (dspec:dspec-progenitor canon-dspec)
+           canon-dspec)
+       nil)
+     location)))
+
+(defun signal-error-data-base (database &optional location)
+  (map-error-database 
+   database
+   (lambda (filename dspec condition)
+     (signal-compiler-condition
+      (format nil "~A" condition)
+      (make-dspec-progenitor-location dspec (or location filename))
+      condition))))
+
+(defun unmangle-unfun (symbol)
+  "Converts symbols like 'SETF::|\"CL-USER\" \"GET\"| to
+function names like \(SETF GET)."
+  (or (and (eq (symbol-package symbol)
+               (load-time-value (find-package :setf)))
+           (let ((slime-nregex::*regex-groupings* 0)
+                 (slime-nregex::*regex-groups* (make-array 10))
+                 (symbol-name (symbol-name symbol)))
+             (and (funcall (load-time-value
+                             (compile nil (slime-nregex:regex-compile "^\"(.+)\" \"(.+)\"$")))
+                           symbol-name)
+                  (list 'setf
+                        (intern (apply #'subseq symbol-name
+                                       (aref slime-nregex::*regex-groups* 2))
+                                (find-package
+                                 (apply #'subseq symbol-name
+                                        (aref slime-nregex::*regex-groups* 1))))))))
+      symbol))
+
+(defun signal-undefined-functions (htab &optional filename)
+  (maphash (lambda (unfun dspecs)
+	     (dolist (dspec dspecs)
+	       (signal-compiler-condition 
+		(format nil "Undefined function ~A" (unmangle-unfun unfun))
+		(make-dspec-progenitor-location dspec
+                                                (or filename
+                                                    (gethash (list unfun dspec)
+                                                             *undefined-functions-hash*)))
+		nil)))
+	   htab))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (assert buffer)
+  (assert position)
+  (let* ((location (list :emacs-buffer buffer position string))
+         (tmpname (hcl:make-temp-file nil "lisp")))
+    (with-swank-compilation-unit (location)
+      (compile-from-temp-file 
+       (with-output-to-string (s)
+         (let ((*print-radix* t))
+           (print `(eval-when (:compile-toplevel)
+                     (setq dspec::*location* (list , at location)))
+                  s))
+         (write-string string s))
+       tmpname))))
+
+;;; xref
+
+(defmacro defxref (name function)
+  `(defimplementation ,name (name)
+    (xref-results (,function name))))
+
+(defxref who-calls      hcl:who-calls)
+(defxref who-macroexpands hcl:who-calls) ; macros are in the calls table too
+(defxref calls-who      hcl:calls-who)
+(defxref list-callers   list-callers-internal)
+;; (defxref list-callees   list-callees-internal)
+
+(defun list-callers-internal (name)
+  (let ((callers (make-array 100
+                             :fill-pointer 0
+                             :adjustable t)))
+    (hcl:sweep-all-objects
+     #'(lambda (object)
+         (when (and #+Harlequin-PC-Lisp (low:compiled-code-p object)
+                    #-Harlequin-PC-Lisp (sys::callablep object)
+                    (system::find-constant$funcallable name object))
+           (vector-push-extend object callers))))
+    ;; Delay dspec:object-dspec until after sweep-all-objects
+    ;; to reduce allocation problems.
+    (loop for object across callers
+          collect (if (symbolp object)
+		      (list 'function object)
+                      (or (dspec:object-dspec object) object)))))
+
+;; only for lispworks 4.2 and above
+#-lispworks4.1
+(progn
+  (defxref who-references hcl:who-references)
+  (defxref who-binds      hcl:who-binds)
+  (defxref who-sets       hcl:who-sets))
+
+(defimplementation who-specializes (classname)
+  (let ((methods (clos:class-direct-methods (find-class classname))))
+    (xref-results (mapcar #'dspec:object-dspec methods))))
+
+(defun xref-results (dspecs)
+  (flet ((frob-locs (dspec locs)
+           (cond (locs
+                  (loop for (name loc) in locs
+                        collect (list name (make-dspec-location name loc))))
+                 (t `((,dspec (:error "Source location not available")))))))
+    (loop for dspec in dspecs
+          append (frob-locs dspec (dspec:dspec-definition-locations dspec)))))
+
+;;; Inspector
+(defclass lispworks-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'lispworks-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (lispworks-inspect o))
+
+(defmethod inspect-for-emacs ((o function) 
+                              (inspector backend-inspector))
+  (declare (ignore inspector))
+  (lispworks-inspect o))
+
+;; FIXME: slot-boundp-using-class in LW works with names so we can't
+;; use our method in swank.lisp.
+(defmethod inspect-for-emacs ((o standard-object) 
+                              (inspector backend-inspector))
+  (declare (ignore inspector))
+  (lispworks-inspect o))
+
+(defun lispworks-inspect (o)
+  (multiple-value-bind (names values _getter _setter type)
+      (lw:get-inspector-values o nil)
+    (declare (ignore _getter _setter))
+    (values "A value."
+            (append 
+             (label-value-line "Type" type)
+             (loop for name in names
+                   for value in values
+                   append (label-value-line name value))))))
+
+;;; Miscellaneous
+
+(defimplementation quit-lisp ()
+  (lispworks:quit))
+
+;;; Tracing
+
+(defun parse-fspec (fspec)
+  "Return a dspec for FSPEC."
+  (ecase (car fspec)
+    ((:defmethod) `(method ,(cdr fspec)))))
+
+(defun tracedp (dspec) 
+  (member dspec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (dspec)
+  (cond ((tracedp dspec)
+         (eval `(untrace ,dspec))
+         (format nil "~S is now untraced." dspec))
+        (t
+         (eval `(trace (,dspec)))
+         (format nil "~S is now traced." dspec))))
+
+(defimplementation toggle-trace (fspec)
+  (toggle-trace-aux (parse-fspec fspec)))
+
+;;; Multithreading
+
+(defimplementation initialize-multiprocessing (continuation)
+  (cond ((not mp::*multiprocessing*)
+         (push (list "Initialize SLIME" '() continuation) 
+               mp:*initial-processes*)
+         (mp:initialize-multiprocessing))
+        (t (funcall continuation))))
+
+(defimplementation spawn (fn &key name)
+  (let ((mp:*process-initial-bindings* 
+         (remove (find-package :cl) 
+                 mp:*process-initial-bindings*
+                 :key (lambda (x) (symbol-package (car x))))))
+    (mp:process-run-function name () fn)))
+
+(defvar *id-lock* (mp:make-lock))
+(defvar *thread-id-counter* 0)
+
+(defimplementation thread-id (thread)
+  (mp:with-lock (*id-lock*)
+    (or (getf (mp:process-plist thread) 'id)
+        (setf (getf (mp:process-plist thread) 'id)
+              (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+  (find id (mp:list-all-processes) 
+        :key (lambda (p) (getf (mp:process-plist p) 'id))))
+
+(defimplementation thread-name (thread)
+  (mp:process-name thread))
+
+(defimplementation thread-status (thread)
+  (format nil "~A ~D" 
+          (mp:process-whostate thread)
+          (mp:process-priority thread)))
+
+(defimplementation make-lock (&key name)
+  (mp:make-lock :name name))
+
+(defimplementation call-with-lock-held (lock function)
+  (mp:with-lock (lock) (funcall function)))
+
+(defimplementation current-thread ()
+  mp:*current-process*)
+
+(defimplementation all-threads ()
+  (mp:list-all-processes))
+
+(defimplementation interrupt-thread (thread fn)
+  (mp:process-interrupt thread fn))
+
+(defimplementation kill-thread (thread)
+  (mp:process-kill thread))
+
+(defimplementation thread-alive-p (thread)
+  (mp:process-alive-p thread))
+
+(defvar *mailbox-lock* (mp:make-lock))
+
+(defun mailbox (thread)
+  (mp:with-lock (*mailbox-lock*)
+    (or (getf (mp:process-plist thread) 'mailbox)
+        (setf (getf (mp:process-plist thread) 'mailbox)
+              (mp:make-mailbox)))))
+
+(defimplementation receive ()
+  (mp:mailbox-read (mailbox mp:*current-process*)))
+
+(defimplementation send (thread object)
+  (mp:mailbox-send (mailbox thread) object))
+
+;;; Some intergration with the lispworks environment
+
+(defun swank-sym (name) (find-symbol (string name) :swank))
+
+(defimplementation emacs-connected ()
+  (when (eq (eval (swank-sym :*communication-style*))
+            nil)
+    (set-sigint-handler))
+  ;; pop up the slime debugger by default
+  (let ((lw:*handle-warn-on-redefinition* :warn))
+    (defmethod env-internals:environment-display-notifier 
+        (env &key restarts condition)
+      (declare (ignore restarts))
+      (funcall (swank-sym :swank-debugger-hook) condition *debugger-hook*))
+    (defmethod env-internals:environment-display-debugger (env)
+      *debug-io*)))
+
+(defimplementation make-stream-interactive (stream)
+  (unless (find-method #'stream:stream-soft-force-output nil `((eql ,stream))
+                       nil)
+    (let ((lw:*handle-warn-on-redefinition* :warn))
+      (defmethod stream:stream-soft-force-output  ((o (eql stream)))
+        (force-output o)))))
+
+(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
+  (apply (swank-sym :y-or-n-p-in-emacs) msg args))
+      
+
+;;;; Weak hashtables
+
+(defimplementation make-weak-key-hash-table (&rest args)
+  (apply #'make-hash-table :weak-kind :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+  (apply #'make-hash-table :weak-kind :value args))

Added: branches/trunk-reorg/thirdparty/slime/swank-loader.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-loader.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-loader.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,236 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-loader.lisp --- Compile and load the Slime backend.
+;;;
+;;; Created 2003, James Bielman <jamesjb at jamesjb.com>
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;
+
+;; If you want customize the source- or fasl-directory you can set
+;; swank-loader:*source-directory* resp. swank-loader:*fasl-directory*
+;; before loading this files. (you also need to create the
+;; swank-loader package.)
+;; E.g.:
+;;
+;;   (make-package :swank-loader)
+;;   (defparameter swank-loader::*fasl-directory* "/tmp/fasl/")
+;;   (load ".../swank-loader.lisp")
+
+(cl:defpackage :swank-loader
+  (:use :cl)
+  (:export :load-swank
+           :*source-directory*
+           :*fasl-directory*))
+
+(cl:in-package :swank-loader)
+
+(defvar *source-directory*
+  (make-pathname :name nil :type nil
+                 :defaults (or *load-pathname* *default-pathname-defaults*))
+  "The directory where to look for the source.")
+
+(defparameter *sysdep-files*
+  (append
+   '("nregex")
+   #+cmu '("swank-source-path-parser" "swank-source-file-cache" "swank-cmucl")
+   #+scl '("swank-source-path-parser" "swank-source-file-cache" "swank-scl")
+   #+sbcl '("swank-source-path-parser" "swank-source-file-cache"
+            "swank-sbcl" "swank-gray")
+   #+openmcl '("metering" "swank-openmcl" "swank-gray")
+   #+lispworks '("swank-lispworks" "swank-gray")
+   #+allegro '("swank-allegro" "swank-gray")
+   #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
+   #+armedbear '("swank-abcl")
+   #+cormanlisp '("swank-corman" "swank-gray")
+   #+ecl '("swank-ecl" "swank-gray")
+   ))
+
+(defparameter *implementation-features*
+  '(:allegro :lispworks :sbcl :openmcl :cmu :clisp :ccl :corman :cormanlisp
+    :armedbear :gcl :ecl :scl))
+
+(defparameter *os-features*
+  '(:macosx :linux :windows :mswindows :win32 :solaris :darwin :sunos :hpux
+    :unix))
+
+(defparameter *architecture-features*
+  '(:powerpc :ppc :x86 :x86-64 :amd64 :i686 :i586 :i486 :pc386 :iapx386
+    :sparc64 :sparc :hppa64 :hppa))
+
+(defun lisp-version-string ()
+  #+cmu       (substitute-if #\_ (lambda (x) (find x " /"))
+                             (lisp-implementation-version))
+  #+scl       (lisp-implementation-version)
+  #+sbcl      (lisp-implementation-version)
+  #+ecl       (lisp-implementation-version)
+  #+openmcl   (format nil "~d.~d"
+                      ccl::*openmcl-major-version*
+                      ccl::*openmcl-minor-version*)
+  #+lispworks (lisp-implementation-version)
+  #+allegro   (format nil
+                      "~A~A~A"
+                      excl::*common-lisp-version-number*
+                      (if (eq 'h 'H) "A" "M")     ; ANSI vs MoDeRn
+                      (if (member :64bit *features*) "-64bit" ""))
+  #+clisp     (let ((s (lisp-implementation-version)))
+                (subseq s 0 (position #\space s)))
+  #+armedbear (lisp-implementation-version)
+  #+cormanlisp (lisp-implementation-version))
+
+(defun unique-directory-name ()
+  "Return a name that can be used as a directory name that is
+unique to a Lisp implementation, Lisp implementation version,
+operating system, and hardware architecture."
+  (flet ((first-of (features)
+           (loop for f in features
+                 when (find f *features*) return it))
+         (maybe-warn (value fstring &rest args)
+           (cond (value)
+                 (t (apply #'warn fstring args)
+                    "unknown"))))
+    (let ((lisp (maybe-warn (first-of *implementation-features*)
+                            "No implementation feature found in ~a."
+                            *implementation-features*))
+          (os   (maybe-warn (first-of *os-features*)
+                            "No os feature found in ~a." *os-features*))
+          (arch (maybe-warn (first-of *architecture-features*)
+                            "No architecture feature found in ~a."
+                            *architecture-features*))
+          (version (maybe-warn (lisp-version-string)
+                               "Don't know how to get Lisp ~
+                                implementation version.")))
+      (format nil "~(~@{~a~^-~}~)" lisp version os arch))))
+
+(defun file-newer-p (new-file old-file)
+  "Returns true if NEW-FILE is newer than OLD-FILE."
+  (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun slime-version-string ()
+  "Return a string identifying the SLIME version.
+Return nil if nothing appropriate is available."
+  (with-open-file (s (merge-pathnames "ChangeLog" *source-directory*)
+                     :if-does-not-exist nil)
+    (and s (symbol-name (read s)))))
+
+(defun default-fasl-directory ()
+  (merge-pathnames
+   (make-pathname
+    :directory `(:relative ".slime" "fasl"
+                 ,@(if (slime-version-string) (list (slime-version-string)))
+                 ,(unique-directory-name)))
+   (user-homedir-pathname)))
+
+(defun binary-pathname (source-pathname binary-directory)
+  "Return the pathname where SOURCE-PATHNAME's binary should be compiled."
+  (let ((cfp (compile-file-pathname source-pathname)))
+    (merge-pathnames (make-pathname :name (pathname-name cfp)
+                                    :type (pathname-type cfp))
+                     binary-directory)))
+
+(defun handle-loadtime-error (condition binary-pathname)
+  (pprint-logical-block (*error-output* () :per-line-prefix ";; ")
+    (format *error-output*
+            "~%Error while loading: ~A~%Condition: ~A~%Aborting.~%"
+            binary-pathname condition))
+  (when (equal (directory-namestring binary-pathname)
+               (directory-namestring (default-fasl-directory)))
+    (ignore-errors (delete-file binary-pathname)))
+  (abort))
+
+(defun compile-files-if-needed-serially (files fasl-directory load)
+  "Compile each file in FILES if the source is newer than
+its corresponding binary, or the file preceding it was
+recompiled."
+  (let ((needs-recompile nil))
+    (dolist (source-pathname files)
+      (let ((binary-pathname (binary-pathname source-pathname
+                                              fasl-directory)))
+        (handler-case
+            (progn
+              (when (or needs-recompile
+                        (not (probe-file binary-pathname))
+                        (file-newer-p source-pathname binary-pathname))
+                ;; need a to recompile source-pathname, so we'll
+                ;; need to recompile everything after this too.
+                (setq needs-recompile t)
+                (ensure-directories-exist binary-pathname)
+                (compile-file source-pathname :output-file binary-pathname
+                              :print nil
+                              :verbose t))
+              (when load
+                (load binary-pathname :verbose t)))
+          ;; Fail as early as possible
+          (serious-condition (c)
+            (handle-loadtime-error c binary-pathname)))))))
+
+#+(or cormanlisp ecl)
+(defun compile-files-if-needed-serially (files fasl-directory)
+  "Corman Lisp and ECL have trouble with compiled files."
+  (declare (ignore fasl-directory))
+  (dolist (file files)
+    (load file :verbose t)
+    (force-output)))
+
+(defun load-user-init-file ()
+  "Load the user init file, return NIL if it does not exist."
+  (load (merge-pathnames (user-homedir-pathname)
+                         (make-pathname :name ".swank" :type "lisp"))
+        :if-does-not-exist nil))
+
+(defun load-site-init-file (directory)
+  (load (make-pathname :name "site-init" :type "lisp"
+                       :defaults directory)
+        :if-does-not-exist nil))
+
+(defun source-files (names src-dir)
+  (mapcar (lambda (name)
+            (make-pathname :name (string-downcase name) :type "lisp"
+                           :defaults src-dir))
+          names))
+
+(defun swank-source-files (src-dir)
+  (source-files `("swank-backend" ,@*sysdep-files* "swank") 
+                src-dir))
+
+(defvar *fasl-directory* (default-fasl-directory)
+  "The directory where fasl files should be placed.")
+
+(defvar *contribs* '(swank-c-p-c swank-arglists swank-fuzzy
+                     swank-fancy-inspector
+                     swank-presentations swank-presentation-streams
+                     #+(or asdf sbcl) swank-asdf
+                     )
+  "List of names for contrib modules.")
+
+(defun append-dir (absolute name)
+  (merge-pathnames 
+   (make-pathname :directory `(:relative ,name) :defaults absolute)
+   absolute))
+
+(defun contrib-src-dir (src-dir)
+  (append-dir src-dir "contrib"))
+
+(defun contrib-source-files (src-dir)
+  (source-files *contribs* (contrib-src-dir src-dir)))
+
+(defun load-swank (&key
+                   (source-directory *source-directory*)
+                   (fasl-directory *fasl-directory*)
+                   (contrib-fasl-directory 
+                    (append-dir fasl-directory "contrib")))
+  (compile-files-if-needed-serially (swank-source-files source-directory)
+                                    fasl-directory t)
+  (compile-files-if-needed-serially (contrib-source-files source-directory)
+                                    contrib-fasl-directory nil))
+
+(load-swank)
+
+(setq swank::*swank-wire-protocol-version* (slime-version-string))
+(setq swank::*load-path* 
+      (append swank::*load-path* (list (contrib-src-dir *source-directory*))))
+(swank-backend::warn-unimplemented-interfaces)
+(load-site-init-file *source-directory*)
+(load-user-init-file)
+(swank:run-after-init-hook)

Added: branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,985 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; openmcl-swank.lisp --- SLIME backend for OpenMCL.
+;;;
+;;; Copyright (C) 2003, James Bielman  <jamesjb at jamesjb.com>
+;;;
+;;; This program is licensed under the terms of the Lisp Lesser GNU
+;;; Public License, known as the LLGPL, and distributed with OpenMCL
+;;; as the file "LICENSE".  The LLGPL consists of a preamble and the
+;;; LGPL, which is distributed with OpenMCL as the file "LGPL".  Where
+;;; these conflict, the preamble takes precedence.
+;;;
+;;; The LLGPL is also available online at
+;;; http://opensource.franz.com/preamble.html
+
+;;;
+;;; This is the beginning of a Slime backend for OpenMCL.  It has been
+;;; tested only with OpenMCL version 0.14-030901 on Darwin --- I would
+;;; be interested in hearing the results with other versions.
+;;;
+;;; Additionally, reporting the positions of warnings accurately requires
+;;; a small patch to the OpenMCL file compiler, which may be found at:
+;;;
+;;;   http://www.jamesjb.com/slime/openmcl-warning-position.diff
+;;;
+;;; Things that work:
+;;;
+;;; * Evaluation of forms with C-M-x.
+;;; * Compilation of defuns with C-c C-c.
+;;; * File compilation with C-c C-k.
+;;; * Most of the debugger functionality, except EVAL-IN-FRAME,
+;;;   FRAME-SOURCE-LOCATION, and FRAME-CATCH-TAGS.
+;;; * Macroexpanding with C-c RET.
+;;; * Disassembling the symbol at point with C-c M-d.
+;;; * Describing symbol at point with C-c C-d.
+;;; * Compiler warnings are trapped and sent to Emacs using the buffer
+;;;   position of the offending top level form.
+;;; * Symbol completion and apropos.
+;;;
+;;; Things that sort of work:
+;;;
+;;; * WHO-CALLS is implemented but is only able to return the file a
+;;;   caller is defined in---source location information is not
+;;;   available.
+;;;
+;;; Things that aren't done yet:
+;;;
+;;; * Cross-referencing.
+;;; * Due to unimplementation functionality the test suite does not
+;;;   run correctly (it hangs upon entering the debugger).
+;;;
+
+(in-package :swank-backend)
+
+(import-from :ccl *gray-stream-symbols* :swank-backend)
+
+(require 'xref)
+
+;;; swank-mop
+
+(import-to-swank-mop
+ '( ;; classes
+   cl:standard-generic-function
+   ccl::standard-slot-definition
+   cl:method
+   cl:standard-class
+   ccl::eql-specializer
+   openmcl-mop:finalize-inheritance
+   ;; standard-class readers
+   openmcl-mop:class-default-initargs
+   openmcl-mop:class-direct-default-initargs
+   openmcl-mop:class-direct-slots
+   openmcl-mop:class-direct-subclasses
+   openmcl-mop:class-direct-superclasses
+   openmcl-mop:class-finalized-p
+   cl:class-name
+   openmcl-mop:class-precedence-list
+   openmcl-mop:class-prototype
+   openmcl-mop:class-slots
+   openmcl-mop:specializer-direct-methods
+   ;; eql-specializer accessors
+   openmcl-mop:eql-specializer-object
+   ;; generic function readers
+   openmcl-mop:generic-function-argument-precedence-order
+   openmcl-mop:generic-function-declarations
+   openmcl-mop:generic-function-lambda-list
+   openmcl-mop:generic-function-methods
+   openmcl-mop:generic-function-method-class
+   openmcl-mop:generic-function-method-combination
+   openmcl-mop:generic-function-name
+   ;; method readers
+   openmcl-mop:method-generic-function
+   openmcl-mop:method-function
+   openmcl-mop:method-lambda-list
+   openmcl-mop:method-specializers
+   openmcl-mop:method-qualifiers
+   ;; slot readers
+   openmcl-mop:slot-definition-allocation
+   ccl::slot-definition-documentation
+   openmcl-mop:slot-value-using-class
+   openmcl-mop:slot-definition-initargs
+   openmcl-mop:slot-definition-initform
+   openmcl-mop:slot-definition-initfunction
+   openmcl-mop:slot-definition-name
+   openmcl-mop:slot-definition-type
+   openmcl-mop:slot-definition-readers
+   openmcl-mop:slot-definition-writers
+   openmcl-mop:slot-boundp-using-class
+   openmcl-mop:slot-makunbound-using-class))
+
+(defun specializer-name (spec)
+  (etypecase spec
+    (cons spec)
+    (class (class-name spec))
+    (ccl::eql-specializer `(eql ,(ccl::eql-specializer-object spec)))))
+
+(defun swank-mop:compute-applicable-methods-using-classes (gf args)
+  (let* ((methods (ccl::%gf-methods gf))
+         (args-length (length args))
+         (bits (ccl::inner-lfun-bits gf))
+         arg-count res)
+    (when methods
+      (setq arg-count (length (ccl::%method-specializers (car methods))))
+      (unless (<= arg-count args-length)
+        (error "Too few args to ~s" gf))
+      (unless (or (logbitp ccl::$lfbits-rest-bit bits)
+                  (logbitp ccl::$lfbits-restv-bit bits)
+                  (logbitp ccl::$lfbits-keys-bit bits)
+                  (<= args-length 
+                      (+ (ldb ccl::$lfbits-numreq bits) (ldb ccl::$lfbits-numopt bits))))
+        (error "Too many args to ~s" gf))
+      (let ((cpls (make-list arg-count)))
+        (declare (dynamic-extent cpls))
+        (do* ((args-tail args (cdr args-tail))
+              (cpls-tail cpls (cdr cpls-tail)))
+             ((null cpls-tail))
+          (setf (car cpls-tail)
+                (ccl::%class-precedence-list (car args-tail))))
+        (flet ((%method-applicable-p (method args cpls)
+                 (do* ((specs (ccl::%method-specializers method) (ccl::%cdr specs))
+                       (args args (ccl::%cdr args))
+                       (cpls cpls (ccl::%cdr cpls)))
+                      ((null specs) t)
+                   (let ((spec (ccl::%car specs)))
+                     (if (typep spec 'ccl::eql-specializer)
+                         (unless (subtypep (ccl::%car args) (class-of (ccl::eql-specializer-object spec)))
+                           (return nil))
+                         (unless (ccl:memq spec (ccl::%car cpls))
+                           (return nil)))))))
+          (dolist (m methods)
+            (if (%method-applicable-p m args cpls)
+                (push m res))))
+        (ccl::sort-methods res cpls (ccl::%gf-precedence-list gf))))))
+
+;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+  :spawn)
+
+(defimplementation create-socket (host port)
+  (ccl:make-socket :connect :passive :local-port port 
+                   :local-host host :reuse-address t))
+
+(defimplementation local-port (socket)
+  (ccl:local-port socket))
+
+(defimplementation close-socket (socket)
+  (close socket))
+
+(defimplementation accept-connection (socket &key external-format
+                                             buffering timeout)
+  (declare (ignore buffering timeout
+                   #-openmcl-unicode-strings external-format))
+  #+openmcl-unicode-strings
+  (when external-format
+    (let ((keys (ccl::socket-keys socket)))
+      (setf (getf keys :external-format) external-format
+            (slot-value socket 'ccl::keys) keys)))
+  (ccl:accept-connection socket :wait t))
+
+#+openmcl-unicode-strings
+(defvar *external-format-to-coding-system*
+  '((:iso-8859-1 
+     "latin-1" "latin-1-unix" "iso-latin-1-unix" 
+     "iso-8859-1" "iso-8859-1-unix")
+    (:utf-8 "utf-8" "utf-8-unix")))
+
+#+openmcl-unicode-strings
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
+
+(defimplementation emacs-connected ()
+  (setq ccl::*interactive-abort-process* ccl::*current-process*))
+
+(defimplementation make-stream-interactive (stream)
+  (typecase stream
+    (ccl:fundamental-output-stream 
+     (push stream ccl::*auto-flush-streams*))))
+
+;;; Unix signals
+
+(defimplementation call-without-interrupts (fn)
+  (ccl:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+  (ccl::getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  "openmcl")
+
+(defvar *break-in-sldb* t)
+
+(let ((ccl::*warn-if-redefine-kernel* nil))
+  (ccl::advise 
+   cl::break 
+   (if (and *break-in-sldb* 
+            (find ccl::*current-process* (symbol-value (intern "*CONNECTIONS*" 'swank))
+                  :key (intern "CONNECTION.REPL-THREAD" 'swank)))
+       (apply 'break-in-sldb ccl::arglist)
+       (:do-it)) :when :around :name sldb-break))
+
+(defun break-in-sldb (&optional string &rest args)
+  (let ((c (make-condition 'simple-condition
+                           :format-control (or string "Break")
+                           :format-arguments args)))
+    (let ((previous-f nil)
+          (previous-f2 nil))
+      (block find-frame
+        (map-backtrace  
+         #'(lambda(frame-number p context lfun pc)
+             (declare (ignore frame-number context pc))
+             (when (eq  previous-f2 'break-in-sldb) 
+               (record-stack-top p)
+               (return-from find-frame))
+             (setq previous-f2 previous-f)
+             (setq previous-f (ccl::lfun-name lfun)))))
+      (restart-case (invoke-debugger c)
+        (continue () :report (lambda (stream) (write-string "Resume interrupted evaluation" stream)) t))
+      )))
+
+; In previous version the code that recorded the function that had an
+; error or which was interrupted was not thread safe. This code repairs that by
+; associating the frame pointer with a process via the *process-to-stack-top* hash.
+
+(defvar *process-to-stack-top* (make-hash-table :test 'eql))
+
+(defun record-stack-top (frame)
+  (setf (gethash (ccl::process-serial-number ccl::*current-process*) *process-to-stack-top* )
+        frame))
+          
+(defun grab-stack-top ()
+  (let ((psn (ccl::process-serial-number ccl::*current-process*)))
+    (ccl::without-interrupts
+      (prog1
+          (gethash  psn *process-to-stack-top*)
+        (setf (gethash psn *process-to-stack-top*) nil)))))
+
+(defmethod ccl::application-error :before (application condition error-pointer)
+  (declare (ignore application condition))
+  (record-stack-top error-pointer)
+  nil)
+
+;;; Evaluation
+
+(defimplementation arglist (fname)
+  (arglist% fname))
+
+(defmethod arglist% ((f symbol))
+  (ccl:arglist f))
+
+(defmethod arglist% ((f function))
+  (ccl:arglist (ccl:function-name f)))
+
+(defimplementation function-name (function)
+  (ccl:function-name function))
+
+;;; Compilation
+
+(defvar *buffer-offset* nil)
+(defvar *buffer-name* nil)
+
+(defun condition-source-position (condition)
+  "Return the position in the source file of a compiler condition."
+  (+ 1
+     (or *buffer-offset* 0)
+     ;; alanr sometimes returned stream position nil.
+     (or (ccl::compiler-warning-stream-position condition) 0))) 
+
+
+(defun handle-compiler-warning (condition)
+  "Construct a compiler note for Emacs from a compiler warning
+condition."
+  (signal (make-condition
+           'compiler-condition
+           :original-condition condition
+           :message (format nil "~A" condition)
+           :severity :warning
+           :location
+           (let ((position (condition-source-position condition)))
+             (if *buffer-name*
+                 (make-location
+                  (list :buffer *buffer-name*)
+                  (list :position position t))
+                 (if (ccl::compiler-warning-file-name condition)
+                     (make-location
+                      (list :file (namestring (truename (ccl::compiler-warning-file-name condition))))
+                      (list :position position t))))))))
+
+(defun temp-file-name ()
+  "Return a temporary file name to compile strings into."
+  (ccl:%get-cstring (#_tmpnam (ccl:%null-ptr))))
+
+(defimplementation call-with-compilation-hooks (function)
+  (handler-bind ((ccl::compiler-warning 'handle-compiler-warning))
+    (funcall function)))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (declare (ignore external-format))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* nil)
+          (*buffer-offset* nil))
+      (compile-file filename :load load-p))))
+
+(defimplementation frame-var-value (frame var)
+  (block frame-var-value
+    (map-backtrace  
+     #'(lambda(frame-number p context lfun pc)
+         (when (= frame frame-number)
+           (return-from frame-var-value 
+             (multiple-value-bind (total vsp parent-vsp)
+                 (ccl::count-values-in-frame p context)
+               (loop for count below total
+                     with varcount = -1
+                     for (value nil name) = (multiple-value-list (ccl::nth-value-in-frame p count context lfun pc vsp parent-vsp))
+                     when name do (incf varcount)
+                     until (= varcount var)
+                     finally (return value))
+               )))))))
+
+(defun xref-locations (relation name &optional (inverse nil))
+  (flet ((function-source-location (entry)
+           (multiple-value-bind (info name)
+               (ccl::edit-definition-p
+                (ccl::%db-key-from-xref-entry entry)
+                (if (eql (ccl::xref-entry-type entry)
+                         'macro)
+                    'function
+                    (ccl::xref-entry-type entry)))
+             (cond ((not info)
+                    (list :error
+                          (format nil "No source info available for ~A"
+                                  (ccl::xref-entry-name entry))))
+                   ((typep (caar info) 'ccl::method)
+                    `(:location 
+                      (:file ,(remove-filename-quoting
+                               (namestring (translate-logical-pathname
+                                            (cdr (car info))))))
+                      (:method
+                          ,(princ-to-string (ccl::method-name (caar info)))
+                        ,(mapcar 'princ-to-string
+                                 (mapcar #'specializer-name
+                                         (ccl::method-specializers
+                                          (caar info))))
+                        ,@(mapcar 'princ-to-string
+                                  (ccl::method-qualifiers (caar info))))
+                      nil))
+                   (t
+                    (canonicalize-location (cdr (first info)) name))))))
+    (declare (dynamic-extent #'function-source-location))
+    (loop for xref in (if inverse 
+                          (ccl::get-relation relation name
+                                             :wild :exhaustive t)
+                          (ccl::get-relation relation
+                                             :wild name :exhaustive t))
+       for function = (ccl::xref-entry-name xref)
+       collect `((function ,function)
+                 ,(function-source-location xref)))))
+
+(defimplementation who-binds (name)
+  (xref-locations :binds name))
+
+(defimplementation who-macroexpands (name)
+  (xref-locations :macro-calls name t))
+  
+(defimplementation who-references (name)
+  (remove-duplicates
+   (append (xref-locations :references name)
+           (xref-locations :sets name)
+           (xref-locations :binds name))
+   :test 'equal))
+
+(defimplementation who-sets (name)
+  (xref-locations :sets name))
+
+(defimplementation who-calls (name)
+  (remove-duplicates
+   (append
+    (xref-locations :direct-calls name)
+    (xref-locations :indirect-calls name)
+    (xref-locations :macro-calls name t))
+   :test 'equal))
+
+(defimplementation list-callees (name)
+  (remove-duplicates
+   (append
+   (xref-locations :direct-calls name t)
+   (xref-locations :macro-calls name nil))
+   :test 'equal))
+
+(defimplementation who-specializes (class)
+  (if (symbolp class) (setq class (find-class class)))
+  (remove-duplicates
+   (append (mapcar (lambda(m)
+                     (let ((location (function-source-location (ccl::method-function m))))
+                       (if (eq (car location) :error)
+                           (setq location nil ))
+                       `((method ,(ccl::method-name m)
+                                 ,(mapcar #'specializer-name (ccl::method-specializers m))
+                                 ,@(ccl::method-qualifiers m))
+                         ,location)))
+                   (ccl::%class.direct-methods class))
+           (mapcan 'who-specializes (ccl::%class-direct-subclasses class)))
+   :test 'equal))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-offset* position)
+          (filename (temp-file-name)))
+      (unwind-protect
+           (with-open-file (s filename :direction :output :if-exists :error)
+             (write-string string s))
+        (let ((binary-filename (compile-file filename :load t)))
+          (delete-file binary-filename)))
+      (delete-file filename))))
+
+;;; Profiling (alanr: lifted from swank-clisp)
+
+(defimplementation profile (fname)
+  (eval `(mon:monitor ,fname)))		;monitor is a macro
+
+(defimplementation profiled-functions ()
+  mon:*monitored-functions*)
+
+(defimplementation unprofile (fname)
+  (eval `(mon:unmonitor ,fname)))	;unmonitor is a macro
+
+(defimplementation unprofile-all ()
+  (mon:unmonitor))
+
+(defimplementation profile-report ()
+  (mon:report-monitoring))
+
+(defimplementation profile-reset ()
+  (mon:reset-all-monitoring))
+
+(defimplementation profile-package (package callers-p methods)
+  (declare (ignore callers-p methods))
+  (mon:monitor-all package))
+
+;;; Debugging
+
+(defun openmcl-set-debug-switches ()
+  (setq ccl::*fasl-save-definitions* nil)
+  (setq ccl::*fasl-save-doc-strings* t)
+  (setq ccl::*fasl-save-local-symbols* t)
+  (setq ccl::*ppc2-compiler-register-save-label* t) 
+  (setq ccl::*save-arglist-info* t)
+  (setq ccl::*save-definitions* nil)
+  (setq ccl::*save-doc-strings* t)
+  (setq ccl::*save-local-symbols* t)
+  (ccl::start-xref))
+
+(defvar *sldb-stack-top* nil)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (let* ((*debugger-hook* nil)
+         (*sldb-stack-top* (grab-stack-top))
+         (ccl::*signal-printing-errors* nil)) ; don't let error while printing error take us down
+    (funcall debugger-loop-fn)))
+
+(defun backtrace-context ()
+  (if (and (= ccl::*openmcl-major-version* 0)
+           (<= ccl::*openmcl-minor-version* 14)
+           (< ccl::*openmcl-revision* 2))
+      (ccl::%current-tcr)
+      nil))
+
+(defun map-backtrace (function &optional
+                      (start-frame-number 0)
+                      (end-frame-number most-positive-fixnum))
+  "Call FUNCTION passing information about each stack frame
+ from frames START-FRAME-NUMBER to END-FRAME-NUMBER."
+  (let ((context (backtrace-context))
+        (frame-number 0)
+        (top-stack-frame (or *sldb-stack-top*
+                             (ccl::%get-frame-ptr))))
+    (do* ((p top-stack-frame (ccl::parent-frame p context))
+          (q (ccl::last-frame-ptr context)))
+         ((or (null p) (eq p q) (ccl::%stack< q p context))
+          (values))
+      (multiple-value-bind (lfun pc) (ccl::cfp-lfun p)
+        (when lfun
+          (if (and (>= frame-number start-frame-number)
+                   (< frame-number end-frame-number))
+              (funcall function frame-number p context lfun pc))
+          (incf frame-number))))))
+
+;; May 13, 2004 alanr: use prin1 instead of princ so I see " around strings. Write ' in front of symbol names and lists.
+;; Sept  6, 2004 alanr: use builtin ccl::frame-supplied-args
+
+(defun frame-arguments (p context lfun pc)
+  "Returns a string representing the arguments of a frame."
+  (multiple-value-bind (args types names count nclosed)
+      (ccl::frame-supplied-args p lfun pc nil context)
+    (declare (ignore count nclosed))
+    (let ((result nil))
+      (loop named loop
+         for var = (cond
+                     ((null args)
+                      (return-from loop))
+                     ((atom args)
+                      (prog1
+                          args
+                        (setf args nil)))
+                     (t (pop args)))
+          for type in types
+          for name in names
+          do
+          (when (or (symbolp var) (listp var)) (setq var (list 'quote var)))
+          (cond ((equal type "keyword")
+                 (push (format nil "~S ~A" 
+                               (intern (symbol-name name) "KEYWORD")
+                               (prin1-to-string var))
+                       result))
+                (t   (push (prin1-to-string var) result))))
+      (format nil "~{ ~A~}" (nreverse result)))))
+
+
+;; XXX should return something less stringy
+;; alanr May 13, 2004: put #<> around anonymous functions in the backtrace.
+
+(defimplementation compute-backtrace (start-frame-number end-frame-number)
+  (let (result)
+    (map-backtrace (lambda (frame-number p  context lfun pc)
+		     (declare (ignore  frame-number))
+                     (push (with-output-to-string (s)
+                             (format s "(~A~A)"
+                                     (if (ccl::function-name lfun)
+					 (ccl::%lfun-name-string lfun)
+					 lfun)
+                                     (frame-arguments p context lfun pc)))
+                           result))
+                   start-frame-number end-frame-number)
+    (nreverse result)))
+
+(defimplementation print-frame (frame stream)
+  (princ frame stream))
+
+(defimplementation frame-locals (index)
+  (block frame-locals
+    (map-backtrace 
+     (lambda (frame-number p context lfun pc)
+       (when (= frame-number index)
+         (multiple-value-bind (count vsp parent-vsp)
+             (ccl::count-values-in-frame p context)
+           (let (result)
+             (dotimes (i count)
+               (multiple-value-bind (var type name)
+                   (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
+                 (declare (ignore type))
+                 (when name
+                   (push (list 
+                          :name name
+                          :id 0
+                          :value var)
+                         result))))
+             (return-from frame-locals (nreverse result)))))))))
+
+(defimplementation frame-catch-tags (index &aux my-frame)
+  (block frame-catch-tags
+    (map-backtrace 
+     (lambda (frame-number p context lfun pc)
+       (declare (ignore pc lfun))
+       (if (= frame-number index) 
+           (setq my-frame p)
+           (when my-frame
+             (return-from frame-catch-tags
+               (loop for catch = (ccl::%catch-top (ccl::%current-tcr)) then (ccl::next-catch catch)
+                     while catch
+                     for csp = (ccl::uvref catch 3) ; ppc32::catch-frame.csp-cell) defined in arch.lisp
+                     for tag = (ccl::uvref catch 0) ; ppc32::catch-frame.catch-tag-cell)
+                     until (ccl::%stack< p csp context)
+                     when (ccl::%stack< my-frame csp context)
+                     collect (cond 
+                               ((symbolp tag)
+                                tag)
+                               ((and (listp tag)
+                                     (typep (car tag) 'restart))
+                                `(:restart ,(restart-name (car tag)))))))))))))
+
+(defimplementation disassemble-frame (the-frame-number)
+  (let ((function-to-disassemble nil))
+    (block find-frame
+      (map-backtrace
+       (lambda(frame-number p context lfun pc)
+         (declare (ignore p context pc))
+         (when (= frame-number the-frame-number)
+           (setq function-to-disassemble lfun)
+           (return-from find-frame)))))
+    (ccl::print-ppc-instructions 
+     *standard-output* 
+     (ccl::function-to-dll-header function-to-disassemble) nil)))
+
+;;;
+
+(defun canonicalize-location (file symbol)
+  (etypecase file
+    ((or string pathname)
+     (multiple-value-bind (truename c) (ignore-errors (namestring (truename file)))
+       (cond (c (list :error (princ-to-string c)))
+             (t (make-location (list :file (remove-filename-quoting truename))
+                               (list :function-name (princ-to-string symbol)))))))))
+
+(defun remove-filename-quoting (string)
+  (if (search "\\" string)
+      (read-from-string (format nil "\"~a\"" string))
+      string))
+
+(defun maybe-method-location (type)
+  (when (typep type 'ccl::method)
+    `((method ,(ccl::method-name type)
+              ,(mapcar #'specializer-name (ccl::method-specializers type))
+              ,@(ccl::method-qualifiers type))
+      ,(function-source-location (ccl::method-function type)))))
+
+(defimplementation find-definitions (symbol)
+  (let* ((info (ccl::get-source-files-with-types&classes symbol)))
+    (loop for (type . file) in info
+          when (not (equal "l1-boot-3" (pathname-name file))) ; alanr: This is a bug - there's nothing in there
+          collect (or (maybe-method-location type)
+                      (list (list type symbol) 
+                            (canonicalize-location file symbol))))))
+
+
+(defun function-source-location (function)
+  (multiple-value-bind (info name) (ccl::edit-definition-p function)
+    (cond ((not info) (list :error (format nil "No source info available for ~A" function)))
+          ((typep (caar info) 'ccl::method)
+           `(:location 
+             (:file ,(remove-filename-quoting (namestring (translate-logical-pathname (cdr (car info))) )))
+             (:method  ,(princ-to-string (ccl::method-name (caar info)))
+               ,(mapcar 'princ-to-string
+                        (mapcar #'specializer-name
+                                (ccl::method-specializers (caar info))))
+               ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info))))
+             nil))
+          (t (canonicalize-location (cdr (first info)) name)))))
+
+(defimplementation frame-source-location-for-emacs (index)
+  "Return to Emacs the location of the source code for the
+function in a debugger frame.  In OpenMCL, we are not able to
+find the precise position of the frame, but we do attempt to give
+at least the filename containing it."
+  (block frame-source-location-for-emacs
+    (map-backtrace
+     (lambda (frame-number p context lfun pc)
+       (declare (ignore p context pc))
+       (when (and (= frame-number index) lfun)
+         (return-from frame-source-location-for-emacs
+           (function-source-location lfun)))))))
+
+(defimplementation eval-in-frame (form index)
+  (block eval-in-frame
+    (map-backtrace
+     (lambda (frame-number p context lfun pc)
+       (when (= frame-number index)
+         (multiple-value-bind (count vsp parent-vsp)
+             (ccl::count-values-in-frame p context)
+           (let ((bindings nil))
+             (dotimes (i count)
+               (multiple-value-bind (var type name)
+                   (ccl::nth-value-in-frame p i context lfun pc vsp parent-vsp)
+                 (declare (ignore type))
+                 (when name
+                   (push (list name `',var) bindings))
+                 ))
+             (return-from eval-in-frame
+               (eval `(let ,bindings
+                        (declare (ignorable ,@(mapcar 'car bindings)))
+                        ,form)))
+             )))))))
+
+(defimplementation return-from-frame (index form)
+  (let ((values (multiple-value-list (eval-in-frame form index))))
+    (map-backtrace
+     (lambda (frame-number p context lfun pc)
+       (declare (ignore context lfun pc))
+       (when (= frame-number index)
+         (ccl::apply-in-frame p #'values values))))))
+ 
+(defimplementation restart-frame (index)
+  (map-backtrace
+   (lambda (frame-number p context lfun pc)
+     (when (= frame-number index)
+       (ccl::apply-in-frame p lfun 
+                            (ccl::frame-supplied-args p lfun pc nil context))))))
+
+;;; Utilities
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (flet ((doc (kind &optional (sym symbol))
+             (or (documentation sym kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (when (boundp symbol)
+                   (doc 'variable)))
+      (maybe-push
+       :function (if (fboundp symbol)
+                     (doc 'function)))
+      (maybe-push
+       :setf (let ((setf-function-name (ccl::setf-function-spec-name 
+                                        `(setf ,symbol))))
+               (when (fboundp setf-function-name)
+                 (doc 'function setf-function-name))))
+      result)))
+
+(defimplementation describe-definition (symbol namespace)
+  (ecase namespace
+    (:variable 
+     (describe symbol))
+    ((:function :generic-function)
+     (describe (symbol-function symbol)))
+    (:setf
+     (describe (ccl::setf-function-spec-name `(setf ,symbol))))
+    (:class
+     (describe (find-class symbol)))))
+
+(defimplementation toggle-trace (spec)
+  "We currently ignore just about everything."
+  (ecase (car spec)
+    (setf
+     (ccl::%trace spec))
+    (:defmethod
+     (ccl::%trace (second spec)))
+    (:defgeneric
+     (ccl::%trace (second spec)))
+    (:call
+     (toggle-trace (third spec)))
+    ;; mb: FIXME: shouldn't we warn that we're not doing anything for
+    ;; these two?
+    (:labels nil)
+    (:flet nil))
+  t)
+
+;;; XREF
+
+(defimplementation list-callers (symbol)
+  (loop for caller in (ccl::callers symbol)
+        append (multiple-value-bind (info name type specializers modifiers)
+                   (ccl::edit-definition-p caller)
+                 (loop for (nil . file) in info
+                       collect (list (if (eq t type)
+                                         name
+                                         `(,type ,name ,specializers
+                                           , at modifiers))
+                                     (canonicalize-location file name))))))
+;;; Macroexpansion
+
+(defvar *value2tag* (make-hash-table))
+
+(do-symbols (s (find-package 'arch))
+  (if (and (> (length (symbol-name s)) 7)
+	   (string= (symbol-name s) "SUBTAG-" :end1 7)
+	   (boundp s)
+	   (numberp (symbol-value s))
+	   (< (symbol-value s) 255))
+      (setf (gethash (symbol-value s) *value2tag*) s)))
+
+;;;; Inspection
+
+(defclass openmcl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'openmcl-inspector))
+
+(defimplementation describe-primitive-type (thing)
+  (let ((typecode (ccl::typecode thing)))
+    (if (gethash typecode *value2tag*)
+	(string (gethash typecode *value2tag*))
+	(string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (let* ((i (inspector::make-inspector o))
+	 (count (inspector::compute-line-count i))
+	 (lines 
+          (loop
+             for l below count
+             for (value label) = (multiple-value-list 
+                                  (inspector::line-n i l))
+             collect `(:value ,label ,(string-capitalize (format nil "~a" label)))
+             collect " = "
+             collect `(:value ,value)
+             collect '(:newline))))
+    (values (with-output-to-string (s)
+              (let ((*print-lines* 1)
+                    (*print-right-margin* 80))
+                (pprint o s)))
+            lines)))
+
+(defmethod inspect-for-emacs :around ((o t) (inspector backend-inspector))
+  (if (or (uvector-inspector-p o)
+          (not (ccl:uvectorp o)))
+      (call-next-method)
+      (multiple-value-bind (title content)
+          (call-next-method)
+        (values
+         title
+         (append content
+                 `((:newline)
+                   (:value ,(make-instance 'uvector-inspector :object o)
+                           "Underlying UVECTOR")))))))
+
+(defclass uvector-inspector ()
+  ((object :initarg :object)))
+
+(defgeneric uvector-inspector-p (object)
+  (:method ((object t)) nil)
+  (:method ((object uvector-inspector)) t))
+
+(defmethod inspect-for-emacs ((uv uvector-inspector) 
+                              (inspector backend-inspector))
+  (with-slots (object)
+      uv
+    (values (format nil "The UVECTOR for ~S." object)
+            (loop
+               for index below (ccl::uvsize object)
+               collect (format nil "~D: " index)
+               collect `(:value ,(ccl::uvref object index))
+               collect `(:newline)))))
+
+(defun closure-closed-over-values (closure)
+  (let ((howmany (nth-value 8 (ccl::function-args (ccl::closure-function closure)))))
+    (loop for n below howmany
+	 collect
+	 (let* ((value (ccl::%svref closure (+ 1 (- howmany n))))
+		(map (car (ccl::function-symbol-map (ccl::closure-function closure))))
+		(label (or (and map (svref map n)) n))
+		(cellp (ccl::closed-over-value-p value)))
+	   (list label (if cellp (ccl::closed-over-value value) value))))))
+
+(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure) (inspector t))
+  (declare (ignore inspector))
+  (values
+   (format nil "A closure: ~a" c)
+   `(,@(if (arglist c)
+	   (list "Its argument list is: " 
+		 (funcall (intern "INSPECTOR-PRINC" 'swank) (arglist c))) 
+           ;; FIXME inspector-princ should load earlier
+	   (list "A function of no arguments"))
+     (:newline)
+     ,@(when (documentation c t)
+	 `("Documentation:" (:newline) ,(documentation c t) (:newline)))
+     ,(format nil "Closed over ~a values"  (length (closure-closed-over-values c)))
+     (:newline)
+     ,@(loop for (name value) in (closure-closed-over-values c)
+	    for count from 1
+	  append
+	  (label-value-line* ((format nil "~2,' d) ~a" count (string name)) value))))))
+
+
+
+
+;;; Multiprocessing
+
+(defvar *known-processes* '()         ; FIXME: leakage. -luke
+  "Alist (ID . PROCESS MAILBOX) list of processes that we have handed
+out IDs for.")
+
+(defvar *known-processes-lock* (ccl:make-lock "*known-processes-lock*"))
+
+(defstruct (mailbox (:conc-name mailbox.)) 
+  (mutex (ccl:make-lock "thread mailbox"))
+  (semaphore (ccl:make-semaphore))
+  (queue '() :type list))
+
+(defimplementation spawn (fn &key name)
+  (ccl:process-run-function (or name "Anonymous (Swank)") fn))
+
+(defimplementation thread-id (thread)
+  (ccl::process-serial-number thread))
+
+(defimplementation find-thread (id)
+  (find id (ccl:all-processes) :key #'ccl::process-serial-number))
+
+(defimplementation thread-name (thread)
+  (ccl::process-name thread))
+
+(defimplementation thread-status (thread)
+  (format nil "~A" (ccl:process-whostate thread)))
+
+(defimplementation make-lock (&key name)
+  (ccl:make-lock name))
+
+(defimplementation call-with-lock-held (lock function)
+  (ccl:with-lock-grabbed (lock)
+    (funcall function)))
+
+(defimplementation current-thread ()
+  ccl:*current-process*)
+
+(defimplementation all-threads ()
+  (ccl:all-processes))
+
+(defimplementation kill-thread (thread)
+  (ccl:process-kill thread))
+
+;; September  5, 2004 alanr. record the frame interrupted
+(defimplementation interrupt-thread (thread fn)
+  (ccl:process-interrupt 
+   thread 
+   (lambda(&rest args)
+     (let ((previous-f nil))
+       (block find-frame
+         (map-backtrace  
+          #'(lambda(frame-number p context lfun pc)
+              (declare (ignore frame-number context pc))
+              (when (eq  previous-f 'ccl::%pascal-functions%) 
+                (record-stack-top p)
+                (return-from find-frame))
+              (setq previous-f (ccl::lfun-name lfun)))))
+       (apply fn args)))))
+
+
+(defun mailbox (thread)
+  (ccl:with-lock-grabbed (*known-processes-lock*)
+    (let ((probe (rassoc thread *known-processes* :key #'car)))
+      (cond (probe (second (cdr probe)))
+            (t (let ((mailbox (make-mailbox)))
+                 (setq *known-processes*
+                       (acons (ccl::process-serial-number thread) 
+                              (list thread mailbox)
+                              (remove-if 
+                               (lambda(entry) 
+                                 (string= (ccl::process-whostate (second entry)) "Exhausted")) 
+                               *known-processes*)
+                              ))
+                 mailbox))))))
+          
+(defimplementation send (thread message)
+  (assert message)
+  (let* ((mbox (mailbox thread))
+         (mutex (mailbox.mutex mbox)))
+    (ccl:with-lock-grabbed (mutex)
+      (setf (mailbox.queue mbox)
+            (nconc (mailbox.queue mbox) (list message)))
+      (ccl:signal-semaphore (mailbox.semaphore mbox)))))
+
+(defimplementation receive ()
+  (let* ((mbox (mailbox ccl:*current-process*))
+         (mutex (mailbox.mutex mbox)))
+    (ccl:wait-on-semaphore (mailbox.semaphore mbox))
+    (ccl:with-lock-grabbed (mutex)
+      (assert (mailbox.queue mbox))
+      (pop (mailbox.queue mbox)))))
+
+(defimplementation quit-lisp ()
+  (ccl::quit))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)
+  (apply #'make-hash-table :weak :key args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+  (apply #'make-hash-table :weak :value args))
+
+(defimplementation hash-table-weakness (hashtable)
+  (ccl::hash-table-weak-p hashtable))

Added: branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,1323 @@
+;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
+;;;
+;;; swank-sbcl.lisp --- SLIME backend for SBCL.
+;;;
+;;; Created 2003, Daniel Barlow <dan at metacircles.com>
+;;;
+;;; This code has been placed in the Public Domain.  All warranties are
+;;; disclaimed.
+
+;;; Requires the SB-INTROSPECT contrib.
+
+;;; Administrivia
+
+(in-package :swank-backend)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (require 'asdf)
+  (require 'sb-bsd-sockets)
+  (require 'sb-introspect)
+  (require 'sb-posix)
+  (require 'sb-cltl2))
+
+(declaim (optimize (debug 2) (sb-c:insert-step-conditions 0)))
+
+(import-from :sb-gray *gray-stream-symbols* :swank-backend)
+
+;;; backwards compability tests
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  ;; Generate a form suitable for testing for stepper support (0.9.17)
+  ;; with #+.
+  (defun sbcl-with-new-stepper-p ()
+    (if (find-symbol "ENABLE-STEPPING" "SB-IMPL")
+        '(:and)
+        '(:or)))
+  ;; Ditto for weak hash-tables
+  (defun sbcl-with-weak-hash-tables ()
+    (if (find-symbol "HASH-TABLE-WEAKNESS" "SB-EXT")
+        '(:and)
+        '(:or)))
+  ;; And for xref support (1.0.1)
+  (defun sbcl-with-xref-p ()
+    (if (find-symbol "WHO-CALLS" "SB-INTROSPECT")
+        '(:and)
+        '(:or)))
+  ;; ... for restart-frame support (1.0.2)
+  (defun sbcl-with-restart-frame ()
+    (if (find-symbol "FRAME-HAS-DEBUG-TAG-P" "SB-DEBUG")
+        '(:and)
+        '(:or))))
+
+;;; swank-mop
+
+(import-swank-mop-symbols :sb-mop '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+  (sb-pcl::documentation slot t))
+
+;;; TCP Server
+
+(defimplementation preferred-communication-style ()
+  (cond
+    ;; fixme: when SBCL/win32 gains better select() support, remove
+    ;; this.
+    ((member :win32 *features*) nil)
+    ((member :sb-thread *features*) :spawn)
+    (t :fd-handler)))
+
+(defun resolve-hostname (name)
+  (car (sb-bsd-sockets:host-ent-addresses
+        (sb-bsd-sockets:get-host-by-name name))))
+
+(defimplementation create-socket (host port)
+  (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
+			       :type :stream
+			       :protocol :tcp)))
+    (setf (sb-bsd-sockets:sockopt-reuse-address socket) t)
+    (sb-bsd-sockets:socket-bind socket (resolve-hostname host) port)
+    (sb-bsd-sockets:socket-listen socket 5)
+    socket))
+
+(defimplementation local-port (socket)
+  (nth-value 1 (sb-bsd-sockets:socket-name socket)))
+
+(defimplementation close-socket (socket)
+  (sb-sys:invalidate-descriptor (socket-fd socket))
+  (sb-bsd-sockets:socket-close socket))
+
+(defimplementation accept-connection (socket &key
+                                      external-format
+                                      buffering timeout)
+  (declare (ignore timeout))
+  (make-socket-io-stream (accept socket)
+                         (or external-format :iso-latin-1-unix)
+                         (or buffering :full)))
+
+(defvar *sigio-handlers* '()
+  "List of (key . fn) pairs to be called on SIGIO.")
+
+(defun sigio-handler (signal code scp)
+  (declare (ignore signal code scp))
+  (mapc (lambda (handler)
+          (funcall (the function (cdr handler))))
+        *sigio-handlers*))
+
+(defun set-sigio-handler ()
+  (sb-sys:enable-interrupt sb-unix:sigio (lambda (signal code scp)
+                                           (sigio-handler signal code scp))))
+
+(defun enable-sigio-on-fd (fd)
+  (sb-posix::fcntl fd sb-posix::f-setfl sb-posix::o-async)
+  (sb-posix::fcntl fd sb-posix::f-setown (getpid)))
+
+(defimplementation add-sigio-handler (socket fn)
+  (set-sigio-handler)
+  (let ((fd (socket-fd socket)))
+    (format *debug-io* "Adding sigio handler: ~S ~%" fd)
+    (enable-sigio-on-fd fd)
+    (push (cons fd fn) *sigio-handlers*)))
+
+(defimplementation remove-sigio-handlers (socket)
+  (let ((fd (socket-fd socket)))
+    (setf *sigio-handlers* (delete fd *sigio-handlers* :key #'car))
+    (sb-sys:invalidate-descriptor fd))
+  (close socket))
+
+(defimplementation add-fd-handler (socket fn)
+  (declare (type function fn))
+  (let ((fd (socket-fd socket)))
+    (format *debug-io* "; Adding fd handler: ~S ~%" fd)
+    (sb-sys:add-fd-handler fd :input (lambda (_)
+                                       _
+                                       (funcall fn)))))
+
+(defimplementation remove-fd-handlers (socket)
+  (sb-sys:invalidate-descriptor (socket-fd socket)))
+
+(defun socket-fd (socket)
+  (etypecase socket
+    (fixnum socket)
+    (sb-bsd-sockets:socket (sb-bsd-sockets:socket-file-descriptor socket))
+    (file-stream (sb-sys:fd-stream-fd socket))))
+
+(defvar *external-format-to-coding-system*
+  '((:iso-8859-1 
+     "latin-1" "latin-1-unix" "iso-latin-1-unix" 
+     "iso-8859-1" "iso-8859-1-unix")
+    (:utf-8 "utf-8" "utf-8-unix")
+    (:euc-jp "euc-jp" "euc-jp-unix")
+    (:us-ascii "us-ascii" "us-ascii-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
+
+(defun make-socket-io-stream (socket external-format buffering)
+  (sb-bsd-sockets:socket-make-stream socket
+                                     :output t
+                                     :input t
+                                     :element-type 'character
+                                     :buffering buffering
+                                     #+sb-unicode :external-format
+                                     #+sb-unicode external-format
+                                     ))
+
+(defun accept (socket)
+  "Like socket-accept, but retry on EAGAIN."
+  (loop (handler-case
+            (return (sb-bsd-sockets:socket-accept socket))
+          (sb-bsd-sockets:interrupted-error ()))))
+
+(defimplementation call-without-interrupts (fn)
+  (declare (type function fn))
+  (sb-sys:without-interrupts (funcall fn)))
+
+(defimplementation getpid ()
+  (sb-posix:getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  "sbcl")
+
+
+;;;; Support for SBCL syntax
+
+;;; SBCL's source code is riddled with #! reader macros.  Also symbols
+;;; containing `!' have special meaning.  We have to work long and
+;;; hard to be able to read the source.  To deal with #! reader
+;;; macros, we use a special readtable.  The special symbols are
+;;; converted by a condition handler.
+
+(defun feature-in-list-p (feature list)
+  (etypecase feature
+    (symbol (member feature list :test #'eq))
+    (cons (flet ((subfeature-in-list-p (subfeature)
+		   (feature-in-list-p subfeature list)))
+	    (ecase (first feature)
+	      (:or  (some  #'subfeature-in-list-p (rest feature)))
+	      (:and (every #'subfeature-in-list-p (rest feature)))
+	      (:not (destructuring-bind (e) (cdr feature)
+                      (not (subfeature-in-list-p e)))))))))
+
+(defun shebang-reader (stream sub-character infix-parameter)
+  (declare (ignore sub-character))
+  (when infix-parameter
+    (error "illegal read syntax: #~D!" infix-parameter))
+  (let ((next-char (read-char stream)))
+    (unless (find next-char "+-")
+      (error "illegal read syntax: #!~C" next-char))
+    ;; When test is not satisfied
+    ;; FIXME: clearer if order of NOT-P and (NOT NOT-P) were reversed? then
+    ;; would become "unless test is satisfied"..
+    (when (let* ((*package* (find-package "KEYWORD"))
+		 (*read-suppress* nil)
+		 (not-p (char= next-char #\-))
+		 (feature (read stream)))
+	    (if (feature-in-list-p feature *features*)
+		not-p
+		(not not-p)))
+      ;; Read (and discard) a form from input.
+      (let ((*read-suppress* t))
+	(read stream t nil t))))
+ (values))
+
+(defvar *shebang-readtable*
+  (let ((*readtable* (copy-readtable nil)))
+    (set-dispatch-macro-character #\# #\!
+                                  (lambda (s c n) (shebang-reader s c n))
+                                  *readtable*)
+    *readtable*))
+
+(defun shebang-readtable ()
+  *shebang-readtable*)
+
+(defun sbcl-package-p (package)
+  (let ((name (package-name package)))
+    (eql (mismatch "SB-" name) 3)))
+
+(defun sbcl-source-file-p (filename)
+  (loop for (_ pattern) in (logical-pathname-translations "SYS")
+        thereis (pathname-match-p filename pattern)))
+
+(defun guess-readtable-for-filename (filename)
+  (if (sbcl-source-file-p filename)
+      (shebang-readtable)
+      *readtable*))
+
+(defvar *debootstrap-packages* t)
+
+(defun call-with-debootstrapping (fun)
+  (handler-bind ((sb-int:bootstrap-package-not-found
+                  #'sb-int:debootstrap-package))
+    (funcall fun)))
+
+(defmacro with-debootstrapping (&body body)
+  `(call-with-debootstrapping (lambda () , at body)))
+
+(defimplementation call-with-syntax-hooks (fn)
+  (cond ((and *debootstrap-packages*
+              (sbcl-package-p *package*))
+         (with-debootstrapping (funcall fn)))
+        (t
+         (funcall fn))))
+
+(defimplementation default-readtable-alist ()
+  (let ((readtable (shebang-readtable)))
+    (loop for p in (remove-if-not #'sbcl-package-p (list-all-packages))
+          collect (cons (package-name p) readtable))))
+
+;;; Utilities
+
+(defimplementation arglist (fname)
+  (sb-introspect:function-arglist fname))
+
+(defimplementation function-name (f)
+  (check-type f function)
+  (sb-impl::%fun-name f))
+
+(defmethod declaration-arglist ((decl-identifier (eql 'optimize)))
+  (flet ((ensure-list (thing) (if (listp thing) thing (list thing))))
+    (let* ((flags (sb-cltl2:declaration-information decl-identifier)))
+      (if flags
+          ;; Symbols aren't printed with package qualifiers, but the FLAGS would
+          ;; have to be fully qualified when used inside a declaration. So we
+          ;; strip those as long as there's no better way. (FIXME)
+          `(&any ,@(remove-if-not #'(lambda (qualifier)
+                                      (find-symbol (symbol-name (first qualifier)) :cl))
+                                  flags :key #'ensure-list))
+          (call-next-method)))))
+
+(defvar *buffer-name* nil)
+(defvar *buffer-offset*)
+(defvar *buffer-substring* nil)
+
+(defvar *previous-compiler-condition* nil
+  "Used to detect duplicates.")
+
+(defun handle-notification-condition (condition)
+  "Handle a condition caused by a compiler warning.
+This traps all compiler conditions at a lower-level than using
+C:*COMPILER-NOTIFICATION-FUNCTION*. The advantage is that we get to
+craft our own error messages, which can omit a lot of redundant
+information."
+  (let ((context (sb-c::find-error-context nil)))
+    (unless (eq condition *previous-compiler-condition*)
+      (setq *previous-compiler-condition* condition)
+      (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+  (signal (make-condition
+           'compiler-condition
+           :original-condition condition
+           :severity (etypecase condition
+                       (sb-c:compiler-error  :error)
+                       (sb-ext:compiler-note :note)
+                       (style-warning        :style-warning)
+                       (warning              :warning)
+                       (error                :error))
+           :short-message (brief-compiler-message-for-emacs condition)
+           :references (condition-references (real-condition condition))
+           :message (long-compiler-message-for-emacs condition context)
+           :location (compiler-note-location context))))
+
+(defun real-condition (condition)
+  "Return the encapsulated condition or CONDITION itself."
+  (typecase condition
+    (sb-int:encapsulated-condition (sb-int:encapsulated-condition condition))
+    (t condition)))
+
+(defun condition-references (condition)
+  (if (typep condition 'sb-int:reference-condition)
+      (externalize-reference
+       (sb-int:reference-condition-references condition))))
+
+(defun compiler-note-location (context)
+  (if context
+      (locate-compiler-note
+       (sb-c::compiler-error-context-file-name context)
+       (compiler-source-path context)
+       (sb-c::compiler-error-context-original-source context))
+      (list :error "No error location available")))
+
+(defun locate-compiler-note (file source-path source)
+  (cond ((and (not (eq file :lisp)) *buffer-name*)
+         ;; Compiling from a buffer
+         (let ((position (+ *buffer-offset*
+                            (source-path-string-position
+                             source-path *buffer-substring*))))
+           (make-location (list :buffer *buffer-name*)
+                          (list :position position))))
+        ((and (pathnamep file) (null *buffer-name*))
+         ;; Compiling from a file
+         (make-location (list :file (namestring file))
+                        (list :position
+                              (1+ (source-path-file-position
+                                   source-path file)))))
+        ((and (eq file :lisp) (stringp source))
+         ;; Compiling macro generated code
+         (make-location (list :source-form source)
+                        (list :position 1)))
+        (t
+         (error "unhandled case in compiler note ~S ~S ~S" file source-path source))))
+
+(defun brief-compiler-message-for-emacs (condition)
+  "Briefly describe a compiler error for Emacs.
+When Emacs presents the message it already has the source popped up
+and the source form highlighted. This makes much of the information in
+the error-context redundant."
+  (let ((sb-int:*print-condition-references* nil))
+    (princ-to-string condition)))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+  "Describe a compiler error for Emacs including context information."
+  (declare (type (or sb-c::compiler-error-context null) error-context))
+  (multiple-value-bind (enclosing source)
+      (if error-context
+          (values (sb-c::compiler-error-context-enclosing-source error-context)
+                  (sb-c::compiler-error-context-source error-context)))
+    (let ((sb-int:*print-condition-references* nil))
+      (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~%~}~]~A"
+              enclosing source condition))))
+
+(defun compiler-source-path (context)
+  "Return the source-path for the current compiler error.
+Returns NIL if this cannot be determined by examining internal
+compiler state."
+  (cond ((sb-c::node-p context)
+         (reverse
+          (sb-c::source-path-original-source
+           (sb-c::node-source-path context))))
+        ((sb-c::compiler-error-context-p context)
+         (reverse
+          (sb-c::compiler-error-context-original-source-path context)))))
+
+(defimplementation call-with-compilation-hooks (function)
+  (declare (type function function))
+  (handler-bind ((sb-c:fatal-compiler-error #'handle-file-compiler-termination)
+                 (sb-c:compiler-error  #'handle-notification-condition)
+                 (sb-ext:compiler-note #'handle-notification-condition)
+                 (style-warning        #'handle-notification-condition)
+                 (warning              #'handle-notification-condition))
+    (funcall function)))
+
+(defun handle-file-compiler-termination (condition)
+  "Handle a condition that caused the file compiler to terminate."
+  (handle-notification-condition
+   (sb-int:encapsulated-condition condition)))
+
+(defvar *trap-load-time-warnings* nil)
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (handler-case
+      (let ((output-file (with-compilation-hooks ()
+                           (compile-file filename 
+                                         :external-format external-format))))
+        (when output-file
+          ;; Cache the latest source file for definition-finding.
+          (source-cache-get filename (file-write-date filename))
+          (when load-p
+            (load output-file))))
+    (sb-c:fatal-compiler-error () nil)))
+
+;;;; compile-string
+
+;;; We copy the string to a temporary file in order to get adequate
+;;; semantics for :COMPILE-TOPLEVEL and :LOAD-TOPLEVEL EVAL-WHEN forms
+;;; which the previous approach using
+;;;     (compile nil `(lambda () ,(read-from-string string)))
+;;; did not provide.
+
+(sb-alien:define-alien-routine "tmpnam" sb-alien:c-string
+  (dest (* sb-alien:c-string)))
+
+(defun temp-file-name ()
+  "Return a temporary file name to compile strings into."
+  (concatenate 'string (tmpnam nil) ".lisp"))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (let ((*buffer-name* buffer)
+        (*buffer-offset* position)
+        (*buffer-substring* string)
+        (filename (temp-file-name)))
+    (flet ((compile-it (fn)
+             (with-compilation-hooks ()
+               (with-compilation-unit
+                   (:source-plist (list :emacs-buffer buffer
+                                        :emacs-directory directory
+                                        :emacs-string string
+                                        :emacs-position position))
+                 (funcall fn (compile-file filename))))))
+      (with-open-file (s filename :direction :output :if-exists :error)
+        (write-string string s))
+      (unwind-protect
+           (if *trap-load-time-warnings*
+               (compile-it #'load)
+               (load (compile-it #'identity)))
+        (ignore-errors
+          (delete-file filename)
+          (delete-file (compile-file-pathname filename)))))))
+
+;;;; Definitions
+
+(defvar *debug-definition-finding* nil
+  "When true don't handle errors while looking for definitions.
+This is useful when debugging the definition-finding code.")
+
+(defparameter *definition-types*
+  '(:variable defvar
+    :constant defconstant
+    :type deftype
+    :symbol-macro define-symbol-macro
+    :macro defmacro
+    :compiler-macro define-compiler-macro
+    :function defun
+    :generic-function defgeneric
+    :method defmethod
+    :setf-expander define-setf-expander
+    :structure defstruct
+    :condition define-condition
+    :class defclass
+    :method-combination define-method-combination
+    :package defpackage
+    :transform :deftransform
+    :optimizer :defoptimizer
+    :vop :define-vop
+    :source-transform :define-source-transform)
+  "Map SB-INTROSPECT definition type names to Slime-friendly forms")
+
+(defimplementation find-definitions (name)
+  (loop for type in *definition-types* by #'cddr
+        for locations = (sb-introspect:find-definition-sources-by-name
+                         name type)
+        append (loop for source-location in locations collect
+                     (make-source-location-specification type name
+                                                         source-location))))
+
+(defun make-source-location-specification (type name source-location)
+  (list (list* (getf *definition-types* type)
+               name
+               (sb-introspect::definition-source-description source-location))
+        (if *debug-definition-finding*
+            (make-definition-source-location source-location type name)
+            (handler-case
+                (make-definition-source-location source-location type name)
+              (error (e)
+                (list :error (format nil "Error: ~A" e)))))))
+
+(defun make-definition-source-location (definition-source type name)
+  (with-struct (sb-introspect::definition-source-
+                   pathname form-path character-offset plist
+                   file-write-date)
+      definition-source
+    (destructuring-bind (&key emacs-buffer emacs-position emacs-directory
+                              emacs-string &allow-other-keys)
+        plist
+      (cond
+        (emacs-buffer
+         (let* ((*readtable* (guess-readtable-for-filename emacs-directory))
+                (pos (if form-path
+                         (with-debootstrapping
+                           (source-path-string-position form-path emacs-string))
+                         character-offset))
+                (snippet (string-path-snippet emacs-string form-path pos)))
+           (make-location `(:buffer ,emacs-buffer)
+                          `(:position ,(+ pos emacs-position))
+                          `(:snippet ,snippet))))
+        ((not pathname)
+         `(:error ,(format nil "Source of ~A ~A not found"
+                           (string-downcase type) name)))
+        (t
+         (let* ((namestring (namestring (translate-logical-pathname pathname)))
+                (pos (source-file-position namestring file-write-date form-path
+                                           character-offset))
+                (snippet (source-hint-snippet namestring file-write-date pos)))
+           (make-location `(:file ,namestring)
+                          `(:position ,pos)
+                          `(:snippet ,snippet))))))))
+
+(defun string-path-snippet (string form-path position)
+  (if form-path
+      ;; If we have a form-path, use it to derive a more accurate
+      ;; snippet, so that we can point to the individual form rather
+      ;; than just the toplevel form.
+      (multiple-value-bind (data end)
+          (let ((*read-suppress* t))
+            (read-from-string string nil nil :start position))
+        (declare (ignore data))
+        (subseq string position end))
+      string))    
+    
+(defun source-file-position (filename write-date form-path character-offset)
+  (let ((source (get-source-code filename write-date))
+        (*readtable* (guess-readtable-for-filename filename)))
+    (1+ (with-debootstrapping
+          (if form-path
+              (source-path-string-position form-path source)
+              (or character-offset 0))))))
+
+(defun source-hint-snippet (filename write-date position)
+  (let ((source (get-source-code filename write-date)))
+    (with-input-from-string (s source)
+      (read-snippet s position))))
+
+(defun function-source-location (function &optional name)
+  (declare (type function function))
+  (let ((location (sb-introspect:find-definition-source function)))
+    (make-definition-source-location location :function name)))
+
+(defun safe-function-source-location (fun name)
+  (if *debug-definition-finding*
+      (function-source-location fun name)
+      (handler-case (function-source-location fun name)
+        (error (e)
+          (list :error (format nil "Error: ~A" e))))))
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  "Return a plist describing SYMBOL.
+Return NIL if the symbol is unbound."
+  (let ((result '()))
+    (flet ((doc (kind)
+             (or (documentation symbol kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (multiple-value-bind (kind recorded-p)
+		     (sb-int:info :variable :kind symbol)
+		   (declare (ignore kind))
+		   (if (or (boundp symbol) recorded-p)
+		       (doc 'variable))))
+      (when (fboundp symbol)
+	(maybe-push
+	 (cond ((macro-function symbol)     :macro)
+	       ((special-operator-p symbol) :special-operator)
+	       ((typep (fdefinition symbol) 'generic-function)
+                :generic-function)
+	       (t :function))
+	 (doc 'function)))
+      (maybe-push
+       :setf (if (or (sb-int:info :setf :inverse symbol)
+		     (sb-int:info :setf :expander symbol))
+		 (doc 'setf)))
+      (maybe-push
+       :type (if (sb-int:info :type :kind symbol)
+		 (doc 'type)))
+      result)))
+
+(defimplementation describe-definition (symbol type)
+  (case type
+    (:variable
+     (describe symbol))
+    (:function
+     (describe (symbol-function symbol)))
+    (:setf
+     (describe (or (sb-int:info :setf :inverse symbol)
+                   (sb-int:info :setf :expander symbol))))
+    (:class
+     (describe (find-class symbol)))
+    (:type
+     (describe (sb-kernel:values-specifier-type symbol)))))
+  
+#+#.(swank-backend::sbcl-with-xref-p)
+(progn
+  (defmacro defxref (name)
+    `(defimplementation ,name (what)
+       (sanitize-xrefs   
+        (mapcar #'source-location-for-xref-data
+                (,(find-symbol (symbol-name name) "SB-INTROSPECT")
+                  what)))))
+  (defxref who-calls)
+  (defxref who-binds)
+  (defxref who-sets)
+  (defxref who-references)
+  (defxref who-macroexpands))
+
+(defun source-location-for-xref-data (xref-data)
+  (let ((name (car xref-data))
+        (source-location (cdr xref-data)))
+    (list name
+          (handler-case (make-definition-source-location source-location
+                                                         'function
+                                                         name)
+            (error (e)
+              (list :error (format nil "Error: ~A" e)))))))
+
+(defimplementation list-callers (symbol)
+  (let ((fn (fdefinition symbol)))
+    (sanitize-xrefs
+     (mapcar #'function-dspec (sb-introspect:find-function-callers fn)))))
+
+(defimplementation list-callees (symbol)
+  (let ((fn (fdefinition symbol)))
+    (sanitize-xrefs
+     (mapcar #'function-dspec (sb-introspect:find-function-callees fn)))))
+
+(defun sanitize-xrefs (xrefs)
+  (remove-duplicates
+   (remove-if (lambda (f)
+                (member f (ignored-xref-function-names)))
+              (loop for entry in xrefs
+                    for name = (car entry)
+                    collect (if (and (consp name)
+                                     (member (car name)
+                                             '(sb-pcl::fast-method
+                                               sb-pcl::slow-method
+                                               sb-pcl::method)))
+                                (cons (cons 'defmethod (cdr name))
+                                      (cdr entry))
+                                entry))
+              :key #'car)
+   :test (lambda (a b)
+           (and (eq (first a) (first b))
+                (equal (second a) (second b))))))
+
+(defun ignored-xref-function-names ()
+  #-#.(swank-backend::sbcl-with-new-stepper-p)
+  '(nil sb-c::step-form sb-c::step-values)
+  #+#.(swank-backend::sbcl-with-new-stepper-p)
+  '(nil))
+
+(defun function-dspec (fn)
+  "Describe where the function FN was defined.
+Return a list of the form (NAME LOCATION)."
+  (let ((name (sb-kernel:%fun-name fn)))
+    (list name (safe-function-source-location fn name))))
+
+;;; macroexpansion
+
+(defimplementation macroexpand-all (form)
+  (let ((sb-walker:*walk-form-expand-macros-p* t))
+    (sb-walker:walk-form form)))
+
+
+;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation install-debugger-globally (function)
+  (setq sb-ext:*invoke-debugger-hook* function))
+
+(defimplementation condition-extras (condition)
+  (cond #+#.(swank-backend::sbcl-with-new-stepper-p)
+        ((typep condition 'sb-impl::step-form-condition)
+         `((:show-frame-source 0)))
+        ((typep condition 'sb-int:reference-condition)
+         (let ((refs (sb-int:reference-condition-references condition)))
+           (if refs
+               `((:references ,(externalize-reference refs))))))))
+
+(defun externalize-reference (ref)
+  (etypecase ref
+    (null nil)
+    (cons (cons (externalize-reference (car ref))
+                (externalize-reference (cdr ref))))
+    ((or string number) ref)
+    (symbol 
+     (cond ((eq (symbol-package ref) (symbol-package :test))
+            ref)
+           (t (symbol-name ref))))))
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (declare (type function debugger-loop-fn))
+  (let* ((*sldb-stack-top* (or sb-debug:*stack-top-hint* (sb-di:top-frame)))
+	 (sb-debug:*stack-top-hint* nil))
+    (handler-bind ((sb-di:debug-condition
+		    (lambda (condition)
+                      (signal (make-condition
+                               'sldb-condition
+                               :original-condition condition)))))
+      (funcall debugger-loop-fn))))
+
+#+#.(swank-backend::sbcl-with-new-stepper-p)
+(progn
+  (defimplementation activate-stepping (frame)
+    (declare (ignore frame))
+    (sb-impl::enable-stepping))
+  (defimplementation sldb-stepper-condition-p (condition)
+    (typep condition 'sb-ext:step-form-condition))
+  (defimplementation sldb-step-into ()
+    (invoke-restart 'sb-ext:step-into))
+  (defimplementation sldb-step-next ()
+    (invoke-restart 'sb-ext:step-next))
+  (defimplementation sldb-step-out ()
+    (invoke-restart 'sb-ext:step-out)))
+
+(defimplementation call-with-debugger-hook (hook fun)
+  (let ((sb-ext:*invoke-debugger-hook* hook)
+        #+#.(swank-backend::sbcl-with-new-stepper-p)
+        (sb-ext:*stepper-hook*
+         (lambda (condition)
+           (typecase condition
+             (sb-ext:step-form-condition
+              (let ((sb-debug:*stack-top-hint* (sb-di::find-stepped-frame)))
+                (sb-impl::invoke-debugger condition)))))))
+    (handler-bind (#+#.(swank-backend::sbcl-with-new-stepper-p)
+                   (sb-ext:step-condition #'sb-impl::invoke-stepper))
+      (funcall fun))))
+
+(defun nth-frame (index)
+  (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
+       (i index (1- i)))
+      ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+  "Return a list of frames starting with frame number START and
+continuing to frame number END or, if END is nil, the last frame on the
+stack."
+  (let ((end (or end most-positive-fixnum)))
+    (loop for f = (nth-frame start) then (sb-di:frame-down f)
+	  for i from start below end
+	  while f
+	  collect f)))
+
+(defimplementation print-frame (frame stream)
+  (sb-debug::print-frame-call frame stream))
+
+;;;; Code-location -> source-location translation
+
+;;; If debug-block info is avaibale, we determine the file position of
+;;; the source-path for a code-location.  If the code was compiled
+;;; with C-c C-c, we have to search the position in the source string.
+;;; If there's no debug-block info, we return the (less precise)
+;;; source-location of the corresponding function.
+
+(defun code-location-source-location (code-location)
+  (let* ((dsource (sb-di:code-location-debug-source code-location))
+         (plist (sb-c::debug-source-plist dsource)))
+    (if (getf plist :emacs-buffer)
+        (emacs-buffer-source-location code-location plist)
+        (ecase (sb-di:debug-source-from dsource)
+          (:file (file-source-location code-location))
+          (:lisp (lisp-source-location code-location))))))
+
+;;; FIXME: The naming policy of source-location functions is a bit
+;;; fuzzy: we have FUNCTION-SOURCE-LOCATION which returns the
+;;; source-location for a function, and we also have FILE-SOURCE-LOCATION &co
+;;; which returns the source location for a _code-location_.
+;;;
+;;; Maybe these should be named code-location-file-source-location,
+;;; etc, turned into generic functions, or something. In the very
+;;; least the names should indicate the main entry point vs. helper
+;;; status.
+
+(defun file-source-location (code-location)
+  (if (code-location-has-debug-block-info-p code-location)
+      (source-file-source-location code-location)
+      (fallback-source-location code-location)))
+
+(defun fallback-source-location (code-location)
+  (let ((fun (code-location-debug-fun-fun code-location)))
+    (cond (fun (function-source-location fun))
+          (t (error "Cannot find source location for: ~A " code-location)))))
+
+(defun lisp-source-location (code-location)
+  (let ((source (prin1-to-string
+                 (sb-debug::code-location-source-form code-location 100))))
+    (make-location `(:source-form ,source) '(:position 0))))
+
+(defun emacs-buffer-source-location (code-location plist)
+  (if (code-location-has-debug-block-info-p code-location)
+      (destructuring-bind (&key emacs-buffer emacs-position emacs-string
+                                &allow-other-keys)
+          plist
+        (let* ((pos (string-source-position code-location emacs-string))
+               (snipped (with-input-from-string (s emacs-string)
+                          (read-snippet s pos))))
+          (make-location `(:buffer ,emacs-buffer)
+                         `(:position ,(+ emacs-position pos))
+                         `(:snippet ,snipped))))
+      (fallback-source-location code-location)))
+
+(defun source-file-source-location (code-location)
+  (let* ((code-date (code-location-debug-source-created code-location))
+         (filename (code-location-debug-source-name code-location))
+         (source-code (get-source-code filename code-date)))
+    (with-input-from-string (s source-code)
+      (let* ((pos (stream-source-position code-location s))
+             (snippet (read-snippet s pos)))
+      (make-location `(:file ,filename)
+                     `(:position ,(1+ pos))
+                     `(:snippet ,snippet))))))
+
+(defun code-location-debug-source-name (code-location)
+  (sb-c::debug-source-name (sb-di::code-location-debug-source code-location)))
+
+(defun code-location-debug-source-created (code-location)
+  (sb-c::debug-source-created
+   (sb-di::code-location-debug-source code-location)))
+
+(defun code-location-debug-fun-fun (code-location)
+  (sb-di:debug-fun-fun (sb-di:code-location-debug-fun code-location)))
+
+(defun code-location-has-debug-block-info-p (code-location)
+  (handler-case
+      (progn (sb-di:code-location-debug-block code-location)
+             t)
+    (sb-di:no-debug-blocks  () nil)))
+
+(defun stream-source-position (code-location stream)
+  (let* ((cloc (sb-debug::maybe-block-start-location code-location))
+	 (tlf-number (sb-di::code-location-toplevel-form-offset cloc))
+	 (form-number (sb-di::code-location-form-number cloc)))
+    (multiple-value-bind (tlf pos-map) (read-source-form tlf-number stream)
+      (let* ((path-table (sb-di::form-number-translations tlf 0))
+             (path (cond ((<= (length path-table) form-number)
+                          (warn "inconsistent form-number-translations")
+                          (list 0))
+                         (t
+                          (reverse (cdr (aref path-table form-number)))))))
+        (source-path-source-position path tlf pos-map)))))
+
+(defun string-source-position (code-location string)
+  (with-input-from-string (s string)
+    (stream-source-position code-location s)))
+
+;;; source-path-file-position and friends are in swank-source-path-parser
+
+(defun safe-source-location-for-emacs (code-location)
+  (if *debug-definition-finding*
+      (code-location-source-location code-location)
+      (handler-case (code-location-source-location code-location)
+        (error (c) (list :error (format nil "~A" c))))))
+
+(defimplementation frame-source-location-for-emacs (index)
+  (safe-source-location-for-emacs
+   (sb-di:frame-code-location (nth-frame index))))
+
+(defun frame-debug-vars (frame)
+  "Return a vector of debug-variables in frame."
+  (sb-di::debug-fun-debug-vars (sb-di:frame-debug-fun frame)))
+
+(defun debug-var-value (var frame location)
+  (ecase (sb-di:debug-var-validity var location)
+    (:valid (sb-di:debug-var-value var frame))
+    ((:invalid :unknown) ':<not-available>)))
+
+(defimplementation frame-locals (index)
+  (let* ((frame (nth-frame index))
+	 (loc (sb-di:frame-code-location frame))
+	 (vars (frame-debug-vars frame)))
+    (loop for v across vars collect
+          (list :name (sb-di:debug-var-symbol v)
+                :id (sb-di:debug-var-id v)
+                :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+  (let* ((frame (nth-frame frame))
+         (dvar (aref (frame-debug-vars frame) var)))
+    (debug-var-value dvar frame (sb-di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+  (mapcar #'car (sb-di:frame-catches (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+  (let ((frame (nth-frame index)))
+    (funcall (the function
+               (sb-di:preprocess-for-eval form
+                                          (sb-di:frame-code-location frame)))
+             frame)))
+
+#+#.(swank-backend::sbcl-with-restart-frame)
+(progn
+  (defimplementation return-from-frame (index form)
+    (let* ((frame (nth-frame index)))
+      (cond ((sb-debug:frame-has-debug-tag-p frame)
+             (let ((values (multiple-value-list (eval-in-frame form index))))
+               (sb-debug:unwind-to-frame-and-call frame
+                                                   (lambda ()
+                                                     (values-list values)))))
+            (t (format nil "Cannot return from frame: ~S" frame)))))
+  
+  (defimplementation restart-frame (index)
+    (let* ((frame (nth-frame index)))
+      (cond ((sb-debug:frame-has-debug-tag-p frame)
+             (let* ((call-list (sb-debug::frame-call-as-list frame))
+                    (fun (fdefinition (car call-list)))
+                    (thunk (lambda () 
+                             ;; Ensure that the thunk gets tail-call-optimized
+                             (declare (optimize (debug 1)))
+                             (apply fun (cdr call-list)))))
+               (sb-debug:unwind-to-frame-and-call frame thunk)))
+            (t (format nil "Cannot restart frame: ~S" frame))))))
+
+;; FIXME: this implementation doesn't unwind the stack before
+;; re-invoking the function, but it's better than no implementation at
+;; all.
+#-#.(swank-backend::sbcl-with-restart-frame)
+(progn
+  (defun sb-debug-catch-tag-p (tag)
+    (and (symbolp tag)
+         (not (symbol-package tag))
+         (string= tag :sb-debug-catch-tag)))
+  
+  (defimplementation return-from-frame (index form)
+    (let* ((frame (nth-frame index))
+           (probe (assoc-if #'sb-debug-catch-tag-p
+                            (sb-di::frame-catches frame))))
+      (cond (probe (throw (car probe) (eval-in-frame form index)))
+            (t (format nil "Cannot return from frame: ~S" frame)))))
+  
+  (defimplementation restart-frame (index)
+    (let ((frame (nth-frame index)))
+      (return-from-frame index (sb-debug::frame-call-as-list frame)))))
+
+;;;;; reference-conditions
+
+(defimplementation format-sldb-condition (condition)
+  (let ((sb-int:*print-condition-references* nil))
+    (princ-to-string condition)))
+
+
+;;;; Profiling
+
+(defimplementation profile (fname)
+  (when fname (eval `(sb-profile:profile ,fname))))
+
+(defimplementation unprofile (fname)
+  (when fname (eval `(sb-profile:unprofile ,fname))))
+
+(defimplementation unprofile-all ()
+  (sb-profile:unprofile)
+  "All functions unprofiled.")
+
+(defimplementation profile-report ()
+  (sb-profile:report))
+
+(defimplementation profile-reset ()
+  (sb-profile:reset)
+  "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+  (sb-profile:profile))
+
+(defimplementation profile-package (package callers methods)
+  (declare (ignore callers methods))
+  (eval `(sb-profile:profile ,(package-name (find-package package)))))
+
+
+;;;; Inspector
+
+(defclass sbcl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'sbcl-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (cond ((sb-di::indirect-value-cell-p o)
+         (values "A value cell." (label-value-line*
+                                  (:value (sb-kernel:value-cell-ref o)))))
+	(t
+	 (multiple-value-bind (text label parts) (sb-impl::inspected-parts o)
+           (if label
+               (values text (loop for (l . v) in parts
+                                  append (label-value-line l v)))
+               (values text (loop for value in parts  for i from 0
+                                  append (label-value-line i value))))))))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (let ((header (sb-kernel:widetag-of o)))
+    (cond ((= header sb-vm:simple-fun-header-widetag)
+	   (values "A simple-fun."
+                   (label-value-line*
+                    (:name (sb-kernel:%simple-fun-name o))
+                    (:arglist (sb-kernel:%simple-fun-arglist o))
+                    (:self (sb-kernel:%simple-fun-self o))
+                    (:next (sb-kernel:%simple-fun-next o))
+                    (:type (sb-kernel:%simple-fun-type o))
+                    (:code (sb-kernel:fun-code-header o)))))
+	  ((= header sb-vm:closure-header-widetag)
+	   (values "A closure."
+                   (append
+                    (label-value-line :function (sb-kernel:%closure-fun o))
+                    `("Closed over values:" (:newline))
+                    (loop for i below (1- (sb-kernel:get-closure-length o))
+                          append (label-value-line
+                                  i (sb-kernel:%closure-index-ref o i))))))
+	  (t (call-next-method o)))))
+
+(defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ backend-inspector))
+  (declare (ignore _))
+  (values (format nil "~A is a code data-block." o)
+          (append
+           (label-value-line*
+            (:code-size (sb-kernel:%code-code-size o))
+            (:entry-points (sb-kernel:%code-entry-points o))
+            (:debug-info (sb-kernel:%code-debug-info o))
+            (:trace-table-offset (sb-kernel:code-header-ref
+                                  o sb-vm:code-trace-table-offset-slot)))
+           `("Constants:" (:newline))
+           (loop for i from sb-vm:code-constants-offset
+                 below (sb-kernel:get-header-data o)
+                 append (label-value-line i (sb-kernel:code-header-ref o i)))
+           `("Code:" (:newline)
+             , (with-output-to-string (s)
+                 (cond ((sb-kernel:%code-debug-info o)
+                        (sb-disassem:disassemble-code-component o :stream s))
+                       (t
+                        (sb-disassem:disassemble-memory
+                         (sb-disassem::align
+                          (+ (logandc2 (sb-kernel:get-lisp-obj-address o)
+                                       sb-vm:lowtag-mask)
+                             (* sb-vm:code-constants-offset
+                                sb-vm:n-word-bytes))
+                          (ash 1 sb-vm:n-lowtag-bits))
+                         (ash (sb-kernel:%code-code-size o) sb-vm:word-shift)
+                         :stream s))))))))
+
+(defmethod inspect-for-emacs ((o sb-ext:weak-pointer) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values "A weak pointer."
+          (label-value-line*
+           (:value (sb-ext:weak-pointer-value o)))))
+
+(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values "A fdefn object."
+          (label-value-line*
+           (:name (sb-kernel:fdefn-name o))
+           (:function (sb-kernel:fdefn-fun o)))))
+
+(defmethod inspect-for-emacs :around ((o generic-function)
+                                      (inspector backend-inspector))
+  (declare (ignore inspector))
+  (multiple-value-bind (title contents) (call-next-method)
+    (values title
+            (append
+             contents
+             (label-value-line*
+              (:pretty-arglist (sb-pcl::generic-function-pretty-arglist o))
+              (:initial-methods (sb-pcl::generic-function-initial-methods o))
+              )))))
+
+
+;;;; Multiprocessing
+
+#+(and sb-thread
+       #.(cl:if (cl:find-symbol "THREAD-NAME" "SB-THREAD") '(and) '(or)))
+(progn
+  (defvar *thread-id-counter* 0)
+
+  (defvar *thread-id-counter-lock*
+    (sb-thread:make-mutex :name "thread id counter lock"))
+
+  (defun next-thread-id ()
+    (sb-thread:with-mutex (*thread-id-counter-lock*)
+      (incf *thread-id-counter*)))
+
+  (defparameter *thread-id-map* (make-hash-table))
+
+  ;; This should be a thread -> id map but as weak keys are not
+  ;; supported it is id -> map instead.
+  (defvar *thread-id-map-lock*
+    (sb-thread:make-mutex :name "thread id map lock"))
+
+  (defimplementation spawn (fn &key name)
+    (sb-thread:make-thread fn :name name))
+
+  (defimplementation thread-id (thread)
+    (block thread-id
+      (sb-thread:with-mutex (*thread-id-map-lock*)
+        (loop for id being the hash-key in *thread-id-map*
+              using (hash-value thread-pointer)
+              do
+              (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+                (cond ((null maybe-thread)
+                       ;; the value is gc'd, remove it manually
+                       (remhash id *thread-id-map*))
+                      ((eq thread maybe-thread)
+                       (return-from thread-id id)))))
+        ;; lazy numbering
+        (let ((id (next-thread-id)))
+          (setf (gethash id *thread-id-map*) (sb-ext:make-weak-pointer thread))
+          id))))
+
+  (defimplementation find-thread (id)
+    (sb-thread:with-mutex (*thread-id-map-lock*)
+      (let ((thread-pointer (gethash id *thread-id-map*)))
+        (if thread-pointer
+            (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+              (if maybe-thread
+                  maybe-thread
+                  ;; the value is gc'd, remove it manually
+                  (progn
+                    (remhash id *thread-id-map*)
+                    nil)))
+            nil))))
+
+  (defimplementation thread-name (thread)
+    ;; sometimes the name is not a string (e.g. NIL)
+    (princ-to-string (sb-thread:thread-name thread)))
+
+  (defimplementation thread-status (thread)
+    (if (sb-thread:thread-alive-p thread)
+        "RUNNING"
+        "STOPPED"))
+
+  (defimplementation make-lock (&key name)
+    (sb-thread:make-mutex :name name))
+
+  (defimplementation call-with-lock-held (lock function)
+    (declare (type function function))
+    (sb-thread:with-mutex (lock) (funcall function)))
+
+  (defimplementation make-recursive-lock (&key name)
+    (sb-thread:make-mutex :name name))
+
+  (defimplementation call-with-recursive-lock-held (lock function)
+    (declare (type function function))
+    (sb-thread:with-recursive-lock (lock) (funcall function)))
+
+  (defimplementation current-thread ()
+    sb-thread:*current-thread*)
+
+  (defimplementation all-threads ()
+    (sb-thread:list-all-threads))
+
+  (defimplementation interrupt-thread (thread fn)
+    (sb-thread:interrupt-thread thread fn))
+
+  (defimplementation kill-thread (thread)
+    (sb-thread:terminate-thread thread))
+
+  (defimplementation thread-alive-p (thread)
+    (sb-thread:thread-alive-p thread))
+
+  (defvar *mailbox-lock* (sb-thread:make-mutex :name "mailbox lock"))
+  (defvar *mailboxes* (list))
+  (declaim (type list *mailboxes*))
+
+  (defstruct (mailbox (:conc-name mailbox.))
+    thread
+    (mutex (sb-thread:make-mutex))
+    (waitqueue  (sb-thread:make-waitqueue))
+    (queue '() :type list))
+
+  (defun mailbox (thread)
+    "Return THREAD's mailbox."
+    (sb-thread:with-mutex (*mailbox-lock*)
+      (or (find thread *mailboxes* :key #'mailbox.thread)
+          (let ((mb (make-mailbox :thread thread)))
+            (push mb *mailboxes*)
+            mb))))
+
+  (defimplementation send (thread message)
+    (let* ((mbox (mailbox thread))
+           (mutex (mailbox.mutex mbox)))
+      (sb-thread:with-mutex (mutex)
+        (setf (mailbox.queue mbox)
+              (nconc (mailbox.queue mbox) (list message)))
+        (sb-thread:condition-broadcast (mailbox.waitqueue mbox)))))
+
+  (defimplementation receive ()
+    (let* ((mbox (mailbox (current-thread)))
+           (mutex (mailbox.mutex mbox)))
+      (sb-thread:with-mutex (mutex)
+        (loop
+         (let ((q (mailbox.queue mbox)))
+           (cond (q (return (pop (mailbox.queue mbox))))
+                 (t (sb-thread:condition-wait (mailbox.waitqueue mbox)
+                                              mutex))))))))
+
+
+  ;; Auto-flush streams
+
+  (defvar *auto-flush-interval* 0.15
+    "How often to flush interactive streams. This valu is passed
+    directly to cl:sleep.")
+
+  (defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
+
+  (defvar *auto-flush-thread* nil)
+
+  (defvar *auto-flush-streams* '())
+  
+  (defimplementation make-stream-interactive (stream)
+    (call-with-recursive-lock-held
+     *auto-flush-lock*
+     (lambda ()
+       (pushnew stream *auto-flush-streams*)
+       (unless *auto-flush-thread*
+         (setq *auto-flush-thread*
+               (sb-thread:make-thread #'flush-streams
+                                      :name "auto-flush-thread"))))))
+
+  (defun flush-streams ()
+    (loop
+     (call-with-recursive-lock-held
+      *auto-flush-lock*
+      (lambda ()
+        (setq *auto-flush-streams*
+              (remove-if (lambda (x)
+                           (not (and (open-stream-p x)
+                                     (output-stream-p x))))
+                         *auto-flush-streams*))
+        (mapc #'finish-output *auto-flush-streams*)))
+     (sleep *auto-flush-interval*)))
+
+  )
+
+(defimplementation quit-lisp ()
+  #+sb-thread
+  (dolist (thread (remove (current-thread) (all-threads)))
+    (ignore-errors (sb-thread:interrupt-thread
+                    thread (lambda () (sb-ext:quit :recklessly-p t)))))
+  (sb-ext:quit))
+
+
+
+;;Trace implementations
+;;In SBCL, we have:
+;; (trace <name>)
+;; (trace :methods '<name>) ;to trace all methods of the gf <name>
+;; (trace (method <name> <qualifier>? (<specializer>+)))
+;; <name> can be a normal name or a (setf name)
+
+(defun toggle-trace-aux (fspec &rest args)
+  (cond ((member fspec (eval '(trace)) :test #'equal)
+         (eval `(untrace ,fspec))
+         (format nil "~S is now untraced." fspec))
+        (t
+         (eval `(trace ,@(if args `(:encapsulate nil) (list)) ,fspec , at args))
+         (format nil "~S is now traced." fspec))))
+
+(defun process-fspec (fspec)
+  (cond ((consp fspec)
+         (ecase (first fspec)
+           ((:defun :defgeneric) (second fspec))
+           ((:defmethod) `(method ,@(rest fspec)))
+           ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
+           ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
+        (t
+         fspec)))
+
+(defimplementation toggle-trace (spec)
+  (ecase (car spec)
+    ((setf)
+     (toggle-trace-aux spec))
+    ((:defmethod)
+     (toggle-trace-aux `(sb-pcl::fast-method ,@(rest (process-fspec spec)))))
+    ((:defgeneric)
+     (toggle-trace-aux (second spec) :methods t))
+    ((:call)
+     (destructuring-bind (caller callee) (cdr spec)
+       (toggle-trace-aux callee :wherein (list (process-fspec caller)))))))
+
+;;; Weak datastructures
+
+(defimplementation make-weak-key-hash-table (&rest args)  
+  #+#.(swank-backend::sbcl-with-weak-hash-tables)
+  (apply #'make-hash-table :weakness :key args)
+  #-#.(swank-backend::sbcl-with-weak-hash-tables)
+  (apply #'make-hash-table args))
+
+(defimplementation make-weak-value-hash-table (&rest args)
+  #+#.(swank-backend::sbcl-with-weak-hash-tables)
+  (apply #'make-hash-table :weakness :value args)
+  #-#.(swank-backend::sbcl-with-weak-hash-tables)
+  (apply #'make-hash-table args))
+
+(defimplementation hash-table-weakness (hashtable)
+  #+#.(swank-backend::sbcl-with-weak-hash-tables)
+  (sb-ext:hash-table-weakness hashtable))

Added: branches/trunk-reorg/thirdparty/slime/swank-scl.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-scl.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-scl.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2070 @@
+;;; -*- indent-tabs-mode: nil; outline-regexp: ";;;;+" -*-
+;;;
+;;; Scieneer Common Lisp code for SLIME.
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;
+
+(in-package :swank-backend)
+
+
+
+;;; swank-mop
+
+(import-swank-mop-symbols :clos '(:slot-definition-documentation))
+
+(defun swank-mop:slot-definition-documentation (slot)
+  (documentation slot t))
+
+
+;;;; TCP server
+;;;
+;;; SCL only supports the :spawn communication style.
+;;;
+
+(defimplementation preferred-communication-style ()
+  :spawn)
+
+(defimplementation create-socket (host port)
+  (let ((addr (resolve-hostname host)))
+    (ext:create-inet-listener port :stream :host addr :reuse-address t)))
+
+(defimplementation local-port (socket)
+  (nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
+
+(defimplementation close-socket (socket)
+  (ext:close-socket (socket-fd socket)))
+
+(defimplementation accept-connection (socket 
+                                      &key external-format buffering timeout)
+  (let ((external-format (or external-format :default))
+        (buffering (or buffering :full))
+        (fd (socket-fd socket)))
+      (loop
+       (let ((ready (sys:wait-until-fd-usable fd :input timeout)))
+         (unless ready
+           (error "Timeout accepting connection on socket: ~S~%" socket)))
+       (let ((new-fd (ignore-errors (ext:accept-tcp-connection fd))))
+         (when new-fd
+           (return (make-socket-io-stream new-fd external-format buffering)))))))
+
+(defimplementation set-stream-timeout (stream timeout)
+  (check-type timeout (or null real))
+  (if (fboundp 'ext::stream-timeout)
+      (setf (ext::stream-timeout stream) timeout)
+      (setf (slot-value (slot-value stream 'cl::stream) 'cl::timeout) timeout)))
+
+;;;;; Sockets
+
+(defun socket-fd (socket)
+  "Return the file descriptor for the socket represented by 'socket."
+  (etypecase socket
+    (fixnum socket)
+    (stream (sys:fd-stream-fd socket))))
+
+(defun resolve-hostname (hostname)
+  "Return the IP address of 'hostname as an integer (in host byte-order)."
+  (let ((hostent (ext:lookup-host-entry hostname)))
+    (car (ext:host-entry-addr-list hostent))))
+
+(defvar *external-format-to-coding-system*
+  '((:iso-8859-1 
+     "latin-1" "latin-1-unix" "iso-latin-1-unix" 
+     "iso-8859-1" "iso-8859-1-unix")
+    (:utf-8 "utf-8" "utf-8-unix")
+    (:euc-jp "euc-jp" "euc-jp-unix")))
+
+(defimplementation find-external-format (coding-system)
+  (car (rassoc-if (lambda (x) (member coding-system x :test #'equal))
+                  *external-format-to-coding-system*)))
+
+(defun make-socket-io-stream (fd external-format buffering)
+  "Create a new input/output fd-stream for 'fd."
+  (let* ((stream (sys:make-fd-stream fd :input t :output t
+                                     :element-type 'base-char
+                                     :buffering buffering
+                                     :external-format external-format)))
+    ;; Ignore character conversion errors.  Without this the communication
+    ;; channel is prone to lockup if a character conversion error occurs.
+    (setf (cl::stream-character-conversion-error-value stream) #\?)
+    stream))
+
+
+;;;; Stream handling
+
+(defclass slime-input-stream (ext:character-input-stream)
+  ((buffer :initarg :buffer :type string)
+   (index :initarg :index :initform 0 :type fixnum)
+   (position :initarg :position :initform 0 :type integer)
+   (interactive :initarg :interactive :initform nil :type (member nil t))
+   (output-stream :initarg :output-stream :initform nil)
+   (input-fn :initarg :input-fn :type function)
+   ))
+
+(defun make-slime-input-stream (input-fn &optional output-stream)
+  (declare (function input-fn))
+  (make-instance 'slime-input-stream
+                 :in-buffer (make-string 256)
+                 :in-head 0 :in-tail 0
+                 :out-buffer ""
+                 :buffer "" :index 0
+                 :input-fn input-fn
+                 :output-stream output-stream))
+
+(defmethod print-object ((s slime-input-stream) stream)
+  (print-unreadable-object (s stream :type t)))
+
+;;; input-stream-p inherits from input-stream.
+;;; output-stream-p inherits nil.
+
+(defmethod ext:stream-listen ((stream slime-input-stream))
+  (let* ((buffer (slot-value stream 'buffer))
+         (index (slot-value stream 'index))
+         (length (length buffer)))
+    (declare (type string buffer)
+             (fixnum index length))
+    (< index length)))
+
+(defmethod close ((stream slime-input-stream) &key ((:abort abort) nil))
+  (declare (ignore abort))
+  (when (ext:stream-open-p stream)
+    (setf (ext:stream-open-p stream) nil)
+    (setf (ext:stream-in-buffer stream) " ")
+    t))
+
+(defmethod ext:stream-clear-input ((stream slime-input-stream))
+  (let* ((input-buffer (slot-value stream 'buffer))
+         (index (slot-value stream 'index))
+         (input-length (length input-buffer))
+         (available (- input-length index))
+         (position (slot-value stream 'position))
+         (new-position (+ position available)))
+    (declare (type kernel:index index available position new-position))
+    (setf (slot-value stream 'position) new-position))
+  (setf (slot-value stream 'buffer) "")
+  (setf (slot-value stream 'index) 0)
+  nil)
+
+;;; No 'stream-finish-output method.
+;;; No 'stream-force-output method.
+;;; No 'stream-clear-output method.
+
+;;; stream-element-type inherits from character-stream.
+
+;;; No 'stream-line-length method.
+;;; No 'stream-line-column method.
+
+;;; Add the remaining input to the current position.
+(defmethod file-length ((stream slime-input-stream))
+  (let* ((input-buffer (slot-value stream 'buffer))
+         (index (slot-value stream 'index))
+         (input-length (length input-buffer))
+         (available (- input-length index))
+         (position (slot-value stream 'position))
+         (file-length (+ position available)))
+    (declare (type kernel:index index available position file-length))
+    file-length))
+
+(defmethod ext:stream-file-position ((stream slime-input-stream)
+                                     &optional position)
+  (let ((current-position (slot-value stream 'position)))
+    (declare (type kernel:index current-position))
+    (cond (position
+           ;; Could make an attempt here, but just give up for now.
+           nil)
+          (t
+           current-position))))
+
+(defmethod interactive-stream-p ((stream slime-input-stream))
+  (slot-value stream 'interactive))
+
+;;; No 'file-string-length method.
+
+(defmethod ext:stream-read-chars ((stream slime-input-stream) buffer
+                                  start requested waitp)
+  (declare (type simple-string buffer)
+	   (type kernel:index start requested))
+  (let* ((input-buffer (slot-value stream 'buffer))
+         (index (slot-value stream 'index))
+         (input-length (length input-buffer))
+         (available (- input-length index))
+	 (copy (min available requested)))
+    (declare (string input-buffer)
+	     (type kernel:index index available copy))
+    (cond ((plusp copy)
+           (dotimes (i copy)
+             (declare (type kernel:index i))
+             (setf (aref buffer (+ start i)) (aref input-buffer (+ index i))))
+           (setf (slot-value stream 'index) (+ index copy))
+           (incf (slot-value stream 'position) copy)
+	   copy)
+	  (waitp
+           (let ((output-stream (slot-value stream 'output-stream))
+                 (input-fn (slot-value stream 'input-fn)))
+             (declare (type function input-fn))
+             (when output-stream
+               (force-output output-stream))
+             (let ((new-input (funcall input-fn)))
+               (cond ((zerop (length new-input))
+                      -1)
+                     (t
+                      (setf (slot-value stream 'buffer) new-input)
+                      (setf (slot-value stream 'index) 0)
+                      (ext:stream-read-chars stream buffer
+                                             start requested waitp))))))
+          (t
+           0))))
+
+;;; Slime output stream.
+
+(defclass slime-output-stream (ext:character-output-stream)
+  ((output-fn :initarg :output-fn :type function)
+   (column :initform 0 :type kernel:index)
+   (interactive :initform nil :type (member nil t))
+   (position :initform 0 :type integer)))
+
+(defun make-slime-output-stream (output-fn)
+  (declare (function output-fn))
+  (make-instance 'slime-output-stream
+		 :in-buffer ""
+		 :out-buffer (make-string 256)
+                 :output-fn output-fn))
+  
+(defmethod print-object ((s slime-output-stream) stream)
+  (print-unreadable-object (s stream :type t)))
+
+;;; Use default 'input-stream-p method for 'output-stream which returns 'nil.
+;;; Use default 'output-stream-p method for 'output-stream which returns 't.
+
+;;; No 'stream-listen method.
+
+(defmethod close ((stream slime-output-stream) &key ((:abort abort) nil))
+  (when (ext:stream-open-p stream)
+    (unless abort
+      (finish-output stream))
+    (setf (ext:stream-open-p stream) nil)
+    (setf (ext:stream-out-buffer stream) " ")
+    t))
+
+;;; No 'stream-clear-input method.
+
+(defmethod ext:stream-finish-output ((stream slime-output-stream))
+  nil)
+
+(defmethod ext:stream-force-output ((stream slime-output-stream))
+  nil)
+
+(defmethod ext:stream-clear-output ((stream slime-output-stream))
+  nil)
+
+;;; Use default 'stream-element-type method for 'character-stream which
+;;; returns 'base-char.
+
+(defmethod ext:stream-line-length ((stream slime-output-stream))
+  80)
+
+(defmethod ext:stream-line-column ((stream slime-output-stream))
+  (slot-value stream 'column))
+
+(defmethod file-length ((stream slime-output-stream))
+  (slot-value stream 'position))
+
+(defmethod ext:stream-file-position ((stream slime-output-stream)
+                                     &optional position)
+  (declare (optimize (speed 3)))
+  (cond (position
+	 (let* ((current-position (slot-value stream 'position))
+                (target-position (etypecase position
+                                   ((member :start) 0)
+                                   ((member :end) current-position)
+                                   (kernel:index position))))
+	   (declare (type kernel:index current-position target-position))
+	   (cond ((= target-position current-position)
+                  t)
+                 ((> target-position current-position)
+                  (let ((output-fn (slot-value stream 'output-fn))
+                        (fill-size (- target-position current-position)))
+                    (declare (function output-fn))
+                    (funcall output-fn (make-string fill-size
+                                                    :initial-element #\space))
+                    (setf (slot-value stream 'position) target-position))
+                  t)
+                 (t
+                  nil))))
+	(t
+	 (slot-value stream 'position))))
+
+(defmethod interactive-stream-p ((stream slime-output-stream))
+  (slot-value stream 'interactive))
+
+;;; Use the default 'character-output-stream 'file-string-length method.
+
+;;; stream-write-chars
+;;;
+;;; The stream out-buffer is typically large enough that there is little point
+;;; growing the stream output 'string large than the total size.  For typical
+;;; usage this reduces consing.  As the string grows larger then grow to
+;;; reduce the cost of copying strings around.
+;;;
+(defmethod ext:stream-write-chars ((stream slime-output-stream)
+                                   string start end waitp)
+  (declare (simple-string string)
+	   (type kernel:index start end)
+           (ignore waitp))
+  (declare (optimize (speed 3)))
+  (unless (ext:stream-open-p stream)
+    (error 'kernel:simple-stream-error
+	   :stream stream
+	   :format-control "Stream closed."))
+  (let* ((string-length (length string))
+         (start (cond ((< start 0) 0)
+                      ((> start string-length) string-length)
+                      (t start)))
+         (end (cond ((< end start) start)
+                    ((> end string-length) string-length)
+                    (t end)))
+         (length (- end start))
+         (output-fn (slot-value stream 'output-fn)))
+    (declare (type kernel:index start end length)
+             (type function output-fn))
+    (unless (zerop length)
+      (funcall output-fn (subseq string start end))
+      (let ((last-newline (position #\newline string :from-end t
+                                    :start start :end end)))
+        (setf (slot-value stream 'column) 
+              (if last-newline
+                  (- end last-newline 1)
+                  (let ((column (slot-value stream 'column)))
+                    (declare (type kernel:index column))
+                    (+ column (- end start))))))))
+  (- end start))
+
+;;;
+
+(defimplementation make-fn-streams (input-fn output-fn)
+  (let* ((output (make-slime-output-stream output-fn))
+         (input  (make-slime-input-stream input-fn output)))
+    (values input output)))
+
+(defimplementation make-stream-interactive (stream)
+  (when (or (typep stream 'slime-input-stream)
+            (typep stream 'slime-output-stream))
+    (setf (slot-value stream 'interactive) t)))
+
+
+;;;; Compilation Commands
+
+(defvar *previous-compiler-condition* nil
+  "Used to detect duplicates.")
+
+(defvar *previous-context* nil
+  "Previous compiler error context.")
+
+(defvar *buffer-name* nil
+  "The name of the Emacs buffer we are compiling from.
+  Nil if we aren't compiling from a buffer.")
+
+(defvar *buffer-start-position* nil)
+(defvar *buffer-substring* nil)
+
+(defimplementation call-with-compilation-hooks (function)
+  (let ((*previous-compiler-condition* nil)
+        (*previous-context* nil)
+        (*print-readably* nil))
+    (handler-bind ((c::compiler-error #'handle-notification-condition)
+                   (c::style-warning  #'handle-notification-condition)
+                   (c::warning        #'handle-notification-condition))
+      (funcall function))))
+
+(defimplementation swank-compile-file (filename load-p external-format)
+  (with-compilation-hooks ()
+    (let ((*buffer-name* nil)
+          (ext:*ignore-extra-close-parentheses* nil))
+      (multiple-value-bind (output-file warnings-p failure-p)
+          (compile-file filename :external-format external-format)
+        (unless failure-p
+          ;; Cache the latest source file for definition-finding.
+          (source-cache-get filename (file-write-date filename))
+          (when load-p (load output-file)))
+        (values output-file warnings-p failure-p)))))
+
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
+  (with-compilation-hooks ()
+    (let ((*buffer-name* buffer)
+          (*buffer-start-position* position)
+          (*buffer-substring* string))
+      (with-input-from-string (stream string)
+        (ext:compile-from-stream 
+         stream 
+         :source-info `(:emacs-buffer ,buffer 
+                        :emacs-buffer-offset ,position
+                        :emacs-buffer-string ,string))))))
+
+
+;;;;; Trapping notes
+;;;
+;;; We intercept conditions from the compiler and resignal them as
+;;; `swank:compiler-condition's.
+
+(defun handle-notification-condition (condition)
+  "Handle a condition caused by a compiler warning."
+  (unless (eq condition *previous-compiler-condition*)
+    (let ((context (c::find-error-context nil)))
+      (setq *previous-compiler-condition* condition)
+      (setq *previous-context* context)
+      (signal-compiler-condition condition context))))
+
+(defun signal-compiler-condition (condition context)
+  (signal (make-condition
+           'compiler-condition
+           :original-condition condition
+           :severity (severity-for-emacs condition)
+           :short-message (brief-compiler-message-for-emacs condition)
+           :message (long-compiler-message-for-emacs condition context)
+           :location (if (read-error-p condition)
+                         (read-error-location condition)
+                         (compiler-note-location context)))))
+
+(defun severity-for-emacs (condition)
+  "Return the severity of 'condition."
+  (etypecase condition
+    ((satisfies read-error-p) :read-error)
+    (c::compiler-error :error)
+    (c::style-warning :note)
+    (c::warning :warning)))
+
+(defun read-error-p (condition)
+  (eq (type-of condition) 'c::compiler-read-error))
+
+(defun brief-compiler-message-for-emacs (condition)
+  "Briefly describe a compiler error for Emacs.
+  When Emacs presents the message it already has the source popped up
+  and the source form highlighted. This makes much of the information in
+  the error-context redundant."
+  (princ-to-string condition))
+
+(defun long-compiler-message-for-emacs (condition error-context)
+  "Describe a compiler error for Emacs including context information."
+  (declare (type (or c::compiler-error-context null) error-context))
+  (multiple-value-bind (enclosing source)
+      (if error-context
+          (values (c::compiler-error-context-enclosing-source error-context)
+                  (c::compiler-error-context-source error-context)))
+    (format nil "~@[--> ~{~<~%--> ~1:;~A~> ~}~%~]~@[~{==>~%~A~^~%~}~]~A"
+            enclosing source condition)))
+
+(defun read-error-location (condition)
+  (let* ((finfo (car (c::source-info-current-file c::*source-info*)))
+         (file (c::file-info-name finfo))
+         (pos (c::compiler-read-error-position condition)))
+    (cond ((and (eq file :stream) *buffer-name*)
+           (make-location (list :buffer *buffer-name*)
+                          (list :position (+ *buffer-start-position* pos))))
+          ((and (pathnamep file) (not *buffer-name*))
+           (make-location (list :file (unix-truename file))
+                          (list :position (1+ pos))))
+          (t (break)))))
+
+(defun compiler-note-location (context)
+  "Derive the location of a complier message from its context.
+  Return a `location' record, or (:error <reason>) on failure."
+  (if (null context)
+      (note-error-location)
+      (let ((file (c::compiler-error-context-file-name context))
+            (source (c::compiler-error-context-original-source context))
+            (path
+             (reverse (c::compiler-error-context-original-source-path context))))
+        (or (locate-compiler-note file source path)
+            (note-error-location)))))
+
+(defun note-error-location ()
+  "Pseudo-location for notes that can't be located."
+  (list :error "No error location available."))
+
+(defun locate-compiler-note (file source source-path)
+  (cond ((and (eq file :stream) *buffer-name*)
+         ;; Compiling from a buffer
+         (let ((position (+ *buffer-start-position*
+                            (source-path-string-position
+                             source-path *buffer-substring*))))
+           (make-location (list :buffer *buffer-name*)
+                          (list :position position))))
+        ((and (pathnamep file) (null *buffer-name*))
+         ;; Compiling from a file
+         (make-location (list :file (unix-truename file))
+                        (list :position
+                              (1+ (source-path-file-position
+                                   source-path file)))))
+        ((and (eq file :lisp) (stringp source))
+         ;; No location known, but we have the source form.
+         ;; XXX How is this case triggered?  -luke (16/May/2004) 
+         ;; This can happen if the compiler needs to expand a macro
+         ;; but the macro-expander is not yet compiled.  Calling the
+         ;; (interpreted) macro-expander triggers IR1 conversion of
+         ;; the lambda expression for the expander and invokes the
+         ;; compiler recursively.
+         (make-location (list :source-form source)
+                        (list :position 1)))))
+
+(defun unix-truename (pathname)
+  (ext:unix-namestring (truename pathname)))
+
+
+
+;;; TODO
+(defimplementation who-calls (name) nil)
+(defimplementation who-references (name) nil)
+(defimplementation who-binds (name) nil)
+(defimplementation who-sets (name) nil)
+(defimplementation who-specializes (symbol) nil)
+(defimplementation who-macroexpands (name) nil)
+
+
+;;;; Find callers and callees
+;;;
+;;; Find callers and callees by looking at the constant pool of
+;;; compiled code objects.  We assume every fdefn object in the
+;;; constant pool corresponds to a call to that function.  A better
+;;; strategy would be to use the disassembler to find actual
+;;; call-sites.
+
+(declaim (inline map-code-constants))
+(defun map-code-constants (code fn)
+  "Call 'fn for each constant in 'code's constant pool."
+  (check-type code kernel:code-component)
+  (loop for i from vm:code-constants-offset below (kernel:get-header-data code)
+	do (funcall fn (kernel:code-header-ref code i))))
+
+(defun function-callees (function)
+  "Return 'function's callees as a list of functions."
+  (let ((callees '()))
+    (map-code-constants 
+     (vm::find-code-object function)
+     (lambda (obj)
+       (when (kernel:fdefn-p obj)
+	 (push (kernel:fdefn-function obj) callees))))
+    callees))
+
+(declaim (ext:maybe-inline map-allocated-code-components))
+(defun map-allocated-code-components (spaces fn)
+  "Call FN for each allocated code component in one of 'spaces.  FN
+  receives the object as argument.  'spaces should be a list of the
+  symbols :dynamic, :static, or :read-only."
+  (dolist (space spaces)
+    (declare (inline vm::map-allocated-objects)
+             (optimize (ext:inhibit-warnings 3)))
+    (vm::map-allocated-objects
+     (lambda (obj header size)
+       (declare (type fixnum size) (ignore size))
+       (when (= vm:code-header-type header)
+	 (funcall fn obj)))
+     space)))
+
+(declaim (ext:maybe-inline map-caller-code-components))
+(defun map-caller-code-components (function spaces fn)
+  "Call 'fn for each code component with a fdefn for 'function in its
+  constant pool."
+  (let ((function (coerce function 'function)))
+    (declare (inline map-allocated-code-components))
+    (map-allocated-code-components
+     spaces 
+     (lambda (obj)
+       (map-code-constants 
+	obj 
+	(lambda (constant)
+	  (when (and (kernel:fdefn-p constant)
+		     (eq (kernel:fdefn-function constant)
+			 function))
+	    (funcall fn obj))))))))
+
+(defun function-callers (function &optional (spaces '(:read-only :static 
+						      :dynamic)))
+  "Return 'function's callers.  The result is a list of code-objects."
+  (let ((referrers '()))
+    (declare (inline map-caller-code-components))
+    (map-caller-code-components function spaces 
+                                (lambda (code) (push code referrers)))
+    referrers))
+
+(defun debug-info-definitions (debug-info)
+  "Return the defintions for a debug-info.  This should only be used
+  for code-object without entry points, i.e., byte compiled
+  code (are theree others?)"
+  ;; This mess has only been tested with #'ext::skip-whitespace, a
+  ;; byte-compiled caller of #'read-char .
+  (check-type debug-info (and (not c::compiled-debug-info) c::debug-info))
+  (let ((name (c::debug-info-name debug-info))
+        (source (c::debug-info-source debug-info)))
+    (destructuring-bind (first) source 
+      (ecase (c::debug-source-from first)
+        (:file 
+         (list (list name
+                     (make-location 
+                      (list :file (unix-truename (c::debug-source-name first)))
+                      (list :function-name (string name))))))))))
+
+(defun valid-function-name-p (name)
+  (or (symbolp name) (and (consp name)
+                          (eq (car name) 'setf)
+                          (symbolp (cadr name))
+                          (not (cddr name)))))
+
+(defun code-component-entry-points (code)
+  "Return a list ((name location) ...) of function definitons for
+  the code omponent 'code."
+  (let ((names '()))
+    (do ((f (kernel:%code-entry-points code) (kernel::%function-next f)))
+        ((not f))
+      (let ((name (kernel:%function-name f)))
+        (when (valid-function-name-p name)
+          (push (list name (function-location f)) names))))
+    names))
+
+(defimplementation list-callers (symbol)
+  "Return a list ((name location) ...) of callers."
+  (let ((components (function-callers symbol))
+        (xrefs '()))
+    (dolist (code components)
+      (let* ((entry (kernel:%code-entry-points code))
+             (defs (if entry
+                       (code-component-entry-points code)
+                       ;; byte compiled stuff
+                       (debug-info-definitions 
+                        (kernel:%code-debug-info code)))))
+        (setq xrefs (nconc defs xrefs))))
+    xrefs))
+
+(defimplementation list-callees (symbol)
+  (let ((fns (function-callees symbol)))
+    (mapcar (lambda (fn)
+              (list (kernel:%function-name fn)
+                    (function-location fn)))
+            fns)))
+
+
+;;;; Resolving source locations
+;;;
+;;; Our mission here is to "resolve" references to code locations into
+;;; actual file/buffer names and character positions. The references
+;;; we work from come out of the compiler's statically-generated debug
+;;; information, such as `code-location''s and `debug-source''s. For
+;;; more details, see the "Debugger Programmer's Interface" section of
+;;; the SCL manual.
+;;;
+;;; The first step is usually to find the corresponding "source-path"
+;;; for the location. Once we have the source-path we can pull up the
+;;; source file and `READ' our way through to the right position. The
+;;; main source-code groveling work is done in
+;;; `swank-source-path-parser.lisp'.
+
+(defvar *debug-definition-finding* nil
+  "When true don't handle errors while looking for definitions.
+  This is useful when debugging the definition-finding code.")
+
+(defvar *source-snippet-size* 256
+  "Maximum number of characters in a snippet of source code.
+  Snippets at the beginning of definitions are used to tell Emacs what
+  the definitions looks like, so that it can accurately find them by
+  text search.")
+
+(defmacro safe-definition-finding (&body body)
+  "Execute 'body and return the source-location it returns.
+  If an error occurs and `*debug-definition-finding*' is false, then
+  return an error pseudo-location.
+
+  The second return value is 'nil if no error occurs, otherwise it is the
+  condition object."
+  `(flet ((body () , at body))
+    (if *debug-definition-finding*
+        (body)
+        (handler-case (values (progn , at body) nil)
+          (error (c) (values (list :error (princ-to-string c)) c))))))
+
+(defun code-location-source-location (code-location)
+  "Safe wrapper around `code-location-from-source-location'."
+  (safe-definition-finding
+   (source-location-from-code-location code-location)))
+
+(defun source-location-from-code-location (code-location)
+  "Return the source location for 'code-location."
+  (let ((debug-fun (di:code-location-debug-function code-location)))
+    (when (di::bogus-debug-function-p debug-fun)
+      ;; Those lousy cheapskates! They've put in a bogus debug source
+      ;; because the code was compiled at a low debug setting.
+      (error "Bogus debug function: ~A" debug-fun)))
+  (let* ((debug-source (di:code-location-debug-source code-location))
+         (from (di:debug-source-from debug-source))
+         (name (di:debug-source-name debug-source)))
+    (ecase from
+      (:file 
+       (location-in-file name code-location debug-source))
+      (:stream
+       (location-in-stream code-location debug-source))
+      (:lisp
+       ;; The location comes from a form passed to `compile'.
+       ;; The best we can do is return the form itself for printing.
+       (make-location
+        (list :source-form (with-output-to-string (*standard-output*)
+                             (debug::print-code-location-source-form 
+                              code-location 100 t)))
+        (list :position 1))))))
+
+(defun location-in-file (filename code-location debug-source)
+  "Resolve the source location for 'code-location in 'filename."
+  (let* ((code-date (di:debug-source-created debug-source))
+         (source-code (get-source-code filename code-date)))
+    (with-input-from-string (s source-code)
+      (make-location (list :file (unix-truename filename))
+                     (list :position (1+ (code-location-stream-position
+                                          code-location s)))
+                     `(:snippet ,(read-snippet s))))))
+
+(defun location-in-stream (code-location debug-source)
+  "Resolve the source location for a 'code-location from a stream.
+  This only succeeds if the code was compiled from an Emacs buffer."
+  (unless (debug-source-info-from-emacs-buffer-p debug-source)
+    (error "The code is compiled from a non-SLIME stream."))
+  (let* ((info (c::debug-source-info debug-source))
+         (string (getf info :emacs-buffer-string))
+         (position (code-location-string-offset 
+                    code-location
+                    string)))
+    (make-location
+     (list :buffer (getf info :emacs-buffer))
+     (list :position (+ (getf info :emacs-buffer-offset) position))
+     (list :snippet (with-input-from-string (s string)
+                      (file-position s position)
+                      (read-snippet s))))))
+
+;;;;; Function-name locations
+;;;
+(defun debug-info-function-name-location (debug-info)
+  "Return a function-name source-location for 'debug-info.
+  Function-name source-locations are a fallback for when precise
+  positions aren't available."
+  (with-struct (c::debug-info- (fname name) source) debug-info
+    (with-struct (c::debug-source- info from name) (car source)
+      (ecase from
+        (:file 
+         (make-location (list :file (namestring (truename name)))
+                        (list :function-name (string fname))))
+        (:stream
+         (assert (debug-source-info-from-emacs-buffer-p (car source)))
+         (make-location (list :buffer (getf info :emacs-buffer))
+                        (list :function-name (string fname))))
+        (:lisp
+         (make-location (list :source-form (princ-to-string (aref name 0)))
+                        (list :position 1)))))))
+
+(defun debug-source-info-from-emacs-buffer-p (debug-source)
+  "Does the `info' slot of 'debug-source contain an Emacs buffer location?
+  This is true for functions that were compiled directly from buffers."
+  (info-from-emacs-buffer-p (c::debug-source-info debug-source)))
+
+(defun info-from-emacs-buffer-p (info)
+  (and info 
+       (consp info)
+       (eq :emacs-buffer (car info))))
+
+
+;;;;; Groveling source-code for positions
+
+(defun code-location-stream-position (code-location stream)
+  "Return the byte offset of 'code-location in 'stream.  Extract the
+  toplevel-form-number and form-number from 'code-location and use that
+  to find the position of the corresponding form.
+
+  Finish with 'stream positioned at the start of the code location."
+  (let* ((location (debug::maybe-block-start-location code-location))
+	 (tlf-offset (di:code-location-top-level-form-offset location))
+	 (form-number (di:code-location-form-number location)))
+    (let ((pos (form-number-stream-position tlf-offset form-number stream)))
+      (file-position stream pos)
+      pos)))
+
+(defun form-number-stream-position (tlf-number form-number stream)
+  "Return the starting character position of a form in 'stream.
+  'tlf-number is the top-level-form number.
+  'form-number is an index into a source-path table for the TLF."
+  (multiple-value-bind (tlf position-map) (read-source-form tlf-number stream)
+    (let* ((path-table (di:form-number-translations tlf 0))
+           (source-path
+            (if (<= (length path-table) form-number) ; source out of sync?
+                (list 0)                ; should probably signal a condition
+                (reverse (cdr (aref path-table form-number))))))
+      (source-path-source-position source-path tlf position-map))))
+  
+(defun code-location-string-offset (code-location string)
+  "Return the byte offset of 'code-location in 'string.
+  See 'code-location-stream-position."
+  (with-input-from-string (s string)
+    (code-location-stream-position code-location s)))
+
+
+;;;; Finding definitions
+
+;;; There are a great many different types of definition for us to
+;;; find. We search for definitions of every kind and return them in a
+;;; list.
+
+(defimplementation find-definitions (name)
+  (append (function-definitions name)
+          (setf-definitions name)
+          (variable-definitions name)
+          (class-definitions name)
+          (type-definitions name)
+          (compiler-macro-definitions name)
+          (source-transform-definitions name)
+          (function-info-definitions name)
+          (ir1-translator-definitions name)))
+
+;;;;; Functions, macros, generic functions, methods
+;;;
+;;; We make extensive use of the compile-time debug information that
+;;; SCL records, in particular "debug functions" and "code
+;;; locations." Refer to the "Debugger Programmer's Interface" section
+;;; of the SCL manual for more details.
+
+(defun function-definitions (name)
+  "Return definitions for 'name in the \"function namespace\", i.e.,
+  regular functions, generic functions, methods and macros.
+  'name can any valid function name (e.g, (setf car))."
+  (let ((macro?    (and (symbolp name) (macro-function name)))
+        (special?  (and (symbolp name) (special-operator-p name)))
+        (function? (and (valid-function-name-p name)
+                        (ext:info :function :definition name)
+                        (if (symbolp name) (fboundp name) t))))
+    (cond (macro? 
+           (list `((defmacro ,name)
+                   ,(function-location (macro-function name)))))
+          (special?
+           (list `((:special-operator ,name) 
+                   (:error ,(format nil "Special operator: ~S" name)))))
+          (function?
+           (let ((function (fdefinition name)))
+             (if (genericp function)
+                 (generic-function-definitions name function)
+                 (list (list `(function ,name)
+                             (function-location function)))))))))
+
+;;;;;; Ordinary (non-generic/macro/special) functions
+;;;
+;;; First we test if FUNCTION is a closure created by defstruct, and
+;;; if so extract the defstruct-description (`dd') from the closure
+;;; and find the constructor for the struct.  Defstruct creates a
+;;; defun for the default constructor and we use that as an
+;;; approximation to the source location of the defstruct.
+;;;
+;;; For an ordinary function we return the source location of the
+;;; first code-location we find.
+;;;
+(defun function-location (function)
+  "Return the source location for FUNCTION."
+  (cond ((struct-closure-p function)
+         (struct-closure-location function))
+        ((c::byte-function-or-closure-p function)
+         (byte-function-location function))
+        (t
+         (compiled-function-location function))))
+
+(defun compiled-function-location (function)
+  "Return the location of a regular compiled function."
+  (multiple-value-bind (code-location error)
+      (safe-definition-finding (function-first-code-location function))
+    (cond (error (list :error (princ-to-string error)))
+          (t (code-location-source-location code-location)))))
+
+(defun function-first-code-location (function)
+  "Return the first code-location we can find for 'function."
+  (and (function-has-debug-function-p function)
+       (di:debug-function-start-location
+        (di:function-debug-function function))))
+
+(defun function-has-debug-function-p (function)
+  (di:function-debug-function function))
+
+(defun function-code-object= (closure function)
+  (and (eq (vm::find-code-object closure)
+	   (vm::find-code-object function))
+       (not (eq closure function))))
+
+
+(defun byte-function-location (fn)
+  "Return the location of the byte-compiled function 'fn."
+  (etypecase fn
+    ((or c::hairy-byte-function c::simple-byte-function)
+     (let* ((component (c::byte-function-component fn))
+            (debug-info (kernel:%code-debug-info component)))
+       (debug-info-function-name-location debug-info)))
+    (c::byte-closure
+     (byte-function-location (c::byte-closure-function fn)))))
+
+;;; Here we deal with structure accessors. Note that `dd' is a
+;;; "defstruct descriptor" structure in SCL. A `dd' describes a
+;;; `defstruct''d structure.
+
+(defun struct-closure-p (function)
+  "Is 'function a closure created by defstruct?"
+  (or (function-code-object= function #'kernel::structure-slot-accessor)
+      (function-code-object= function #'kernel::structure-slot-setter)
+      (function-code-object= function #'kernel::%defstruct)))
+
+(defun struct-closure-location (function)
+  "Return the location of the structure that 'function belongs to."
+  (assert (struct-closure-p function))
+  (safe-definition-finding
+    (dd-location (struct-closure-dd function))))
+
+(defun struct-closure-dd (function)
+  "Return the defstruct-definition (dd) of FUNCTION."
+  (assert (= (kernel:get-type function) vm:closure-header-type))
+  (flet ((find-layout (function)
+	   (sys:find-if-in-closure 
+	    (lambda (x) 
+	      (let ((value (if (di::indirect-value-cell-p x)
+			       (c:value-cell-ref x) 
+			       x)))
+		(when (kernel::layout-p value)
+		  (return-from find-layout value))))
+	    function)))
+    (kernel:layout-info (find-layout function))))
+
+(defun dd-location (dd)
+  "Return the location of a `defstruct'."
+  ;; Find the location in a constructor.
+  (function-location (struct-constructor dd)))
+
+(defun struct-constructor (dd)
+  "Return a constructor function from a defstruct definition.
+Signal an error if no constructor can be found."
+  (let ((constructor (or (kernel:dd-default-constructor dd)
+                         (car (kernel::dd-constructors dd)))))
+    (when (or (null constructor)
+              (and (consp constructor) (null (car constructor))))
+      (error "Cannot find structure's constructor: ~S"
+             (kernel::dd-name dd)))
+    (coerce (if (consp constructor) (first constructor) constructor)
+            'function)))
+
+;;;;;; Generic functions and methods
+
+(defun generic-function-definitions (name function)
+  "Return the definitions of a generic function and its methods."
+  (cons (list `(defgeneric ,name) (gf-location function))
+        (gf-method-definitions function)))
+
+(defun gf-location (gf)
+  "Return the location of the generic function GF."
+  (definition-source-location gf (clos:generic-function-name gf)))
+
+(defun gf-method-definitions (gf)
+  "Return the locations of all methods of the generic function GF."
+  (mapcar #'method-definition (clos:generic-function-methods gf)))
+
+(defun method-definition (method)
+  (list (method-dspec method)
+        (method-location method)))
+
+(defun method-dspec (method)
+  "Return a human-readable \"definition specifier\" for METHOD."
+  (let* ((gf (clos:method-generic-function method))
+         (name (clos:generic-function-name gf))
+         (specializers (clos:method-specializers method))
+         (qualifiers (clos:method-qualifiers method)))
+    `(method ,name , at qualifiers ,specializers #+nil (clos::unparse-specializers specializers))))
+
+;; XXX maybe special case setters/getters
+(defun method-location (method)
+  (function-location (clos:method-function method)))
+
+(defun genericp (fn)
+  (typep fn 'generic-function))
+
+;;;;;; Types and classes
+
+(defun type-definitions (name)
+  "Return `deftype' locations for type NAME."
+  (maybe-make-definition (ext:info :type :expander name) 'deftype name))
+
+(defun maybe-make-definition (function kind name)
+  "If FUNCTION is non-nil then return its definition location."
+  (if function
+      (list (list `(,kind ,name) (function-location function)))))
+
+(defun class-definitions (name)
+  "Return the definition locations for the class called NAME."
+  (if (symbolp name)
+      (let ((class (find-class name nil)))
+        (etypecase class
+          (null '())
+          (structure-class
+           (list (list `(defstruct ,name)
+                       (dd-location (find-dd name)))))
+          (standard-class
+           (list (list `(defclass ,name) 
+                       (class-location (find-class name)))))
+          ((or built-in-class 
+               kernel:funcallable-structure-class)
+           (list (list `(kernel::define-type-class ,name)
+                       `(:error 
+                         ,(format nil "No source info for ~A" name)))))))))
+
+(defun class-location (class)
+  "Return the `defclass' location for CLASS."
+  (definition-source-location class (class-name class)))
+
+(defun find-dd (name)
+  "Find the defstruct-definition by the name of its structure-class."
+  (let ((layout (ext:info :type :compiler-layout name)))
+    (if layout 
+        (kernel:layout-info layout))))
+
+(defun condition-class-location (class)
+  (let ((name (class-name class)))
+    `(:error ,(format nil "No location info for condition: ~A" name))))
+
+(defun make-name-in-file-location (file string)
+  (multiple-value-bind (filename c)
+      (ignore-errors 
+        (unix-truename (merge-pathnames (make-pathname :type "lisp")
+                                        file)))
+    (cond (filename (make-location `(:file ,filename)
+                                   `(:function-name ,(string string))))
+          (t (list :error (princ-to-string c))))))
+
+(defun definition-source-location (object name)
+  `(:error ,(format nil "No source info for: ~A" object)))
+
+(defun setf-definitions (name)
+  (let ((function (or (ext:info :setf :inverse name)
+                      (ext:info :setf :expander name))))
+    (if function
+        (list (list `(setf ,name) 
+                    (function-location (coerce function 'function)))))))
+
+
+(defun variable-location (symbol)
+  `(:error ,(format nil "No source info for variable ~S" symbol)))
+
+(defun variable-definitions (name)
+  (if (symbolp name)
+      (multiple-value-bind (kind recorded-p) (ext:info :variable :kind name)
+        (if recorded-p
+            (list (list `(variable ,kind ,name)
+                        (variable-location name)))))))
+
+(defun compiler-macro-definitions (symbol)
+  (maybe-make-definition (compiler-macro-function symbol)
+                         'define-compiler-macro
+                         symbol))
+
+(defun source-transform-definitions (name)
+  (maybe-make-definition (ext:info :function :source-transform name)
+                         'c:def-source-transform
+                         name))
+
+(defun function-info-definitions (name)
+  (let ((info (ext:info :function :info name)))
+    (if info
+        (append (loop for transform in (c::function-info-transforms info)
+                      collect (list `(c:deftransform ,name 
+                                      ,(c::type-specifier 
+                                        (c::transform-type transform)))
+                                    (function-location (c::transform-function 
+                                                        transform))))
+                (maybe-make-definition (c::function-info-derive-type info)
+                                       'c::derive-type name)
+                (maybe-make-definition (c::function-info-optimizer info)
+                                       'c::optimizer name)
+                (maybe-make-definition (c::function-info-ltn-annotate info)
+                                       'c::ltn-annotate name)
+                (maybe-make-definition (c::function-info-ir2-convert info)
+                                       'c::ir2-convert name)
+                (loop for template in (c::function-info-templates info)
+                      collect (list `(c::vop ,(c::template-name template))
+                                    (function-location 
+                                     (c::vop-info-generator-function 
+                                      template))))))))
+
+(defun ir1-translator-definitions (name)
+  (maybe-make-definition (ext:info :function :ir1-convert name)
+                         'c:def-ir1-translator name))
+
+
+;;;; Documentation.
+
+(defimplementation describe-symbol-for-emacs (symbol)
+  (let ((result '()))
+    (flet ((doc (kind)
+             (or (documentation symbol kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
+      (maybe-push
+       :variable (multiple-value-bind (kind recorded-p)
+		     (ext:info variable kind symbol)
+		   (declare (ignore kind))
+		   (if (or (boundp symbol) recorded-p)
+		       (doc 'variable))))
+      (when (fboundp symbol)
+	(maybe-push
+	 (cond ((macro-function symbol)     :macro)
+	       ((special-operator-p symbol) :special-operator)
+	       ((genericp (fdefinition symbol)) :generic-function)
+	       (t :function))
+	 (doc 'function)))
+      (maybe-push
+       :setf (if (or (ext:info setf inverse symbol)
+		     (ext:info setf expander symbol))
+		 (doc 'setf)))
+      (maybe-push
+       :type (if (ext:info type kind symbol)
+		 (doc 'type)))
+      (maybe-push
+       :class (if (find-class symbol nil) 
+		  (doc 'class)))
+      (maybe-push
+       :alien-type (if (not (eq (ext:info alien-type kind symbol) :unknown))
+		       (doc 'alien-type)))
+      (maybe-push
+       :alien-struct (if (ext:info alien-type struct symbol)
+			 (doc nil)))
+      (maybe-push
+       :alien-union (if (ext:info alien-type union symbol)
+			 (doc nil)))
+      (maybe-push
+       :alien-enum (if (ext:info alien-type enum symbol)
+		       (doc nil)))
+      result)))
+
+(defimplementation describe-definition (symbol namespace)
+  (describe (ecase namespace
+              (:variable
+               symbol)
+              ((:function :generic-function)
+               (symbol-function symbol))
+              (:setf
+               (or (ext:info setf inverse symbol)
+                   (ext:info setf expander symbol)))
+              (:type
+               (kernel:values-specifier-type symbol))
+              (:class
+               (find-class symbol))
+              (:alien-struct
+               (ext:info :alien-type :struct symbol))
+              (:alien-union
+               (ext:info :alien-type :union symbol))
+              (:alien-enum
+               (ext:info :alien-type :enum symbol))
+              (:alien-type
+               (ecase (ext:info :alien-type :kind symbol)
+                 (:primitive
+                  (let ((alien::*values-type-okay* t))
+                    (funcall (ext:info :alien-type :translator symbol) 
+                             (list symbol))))
+                 ((:defined)
+                  (ext:info :alien-type :definition symbol))
+                 (:unknown :unknown))))))
+
+;;;;; Argument lists
+
+(defimplementation arglist (fun)
+  (etypecase fun
+    (function (function-arglist fun))
+    (symbol (function-arglist (or (macro-function fun)
+                                  (symbol-function fun))))))
+
+(defun function-arglist (fun)
+  (flet ((compiled-function-arglist (x)
+           (let ((args (kernel:%function-arglist x)))
+             (if args
+                 (read-arglist x)
+                 :not-available))))
+    (case (kernel:get-type fun)
+      (#.vm:closure-header-type
+       (compiled-function-arglist
+        (kernel:%closure-function fun)))
+      ((#.vm:function-header-type #.vm:closure-function-header-type)
+       (compiled-function-arglist fun))
+      (#.vm:funcallable-instance-header-type
+       (typecase fun
+         (kernel:byte-function
+          :not-available)
+         (kernel:byte-closure
+          :not-available)
+         (eval:interpreted-function
+          (eval:interpreted-function-arglist fun))
+         (otherwise
+          (clos::generic-function-lambda-list fun))))
+      (t
+       :non-available))))
+
+(defimplementation function-name (function)
+  (cond ((eval:interpreted-function-p function)
+         (eval:interpreted-function-name function))
+        ((typep function 'generic-function)
+         (clos:generic-function-name function))
+        ((c::byte-function-or-closure-p function)
+         (c::byte-function-name function))
+        (t (kernel:%function-name (kernel:%function-self function)))))
+
+;;; A simple case: the arglist is available as a string that we can
+;;; `read'.
+
+(defun read-arglist (fn)
+  "Parse the arglist-string of the function object FN."
+  (let ((string (kernel:%function-arglist
+                 (kernel:%function-self fn)))
+        (package (find-package
+                  (c::compiled-debug-info-package
+                   (kernel:%code-debug-info
+                    (vm::find-code-object fn))))))
+    (with-standard-io-syntax
+      (let ((*package* (or package *package*)))
+        (read-from-string string)))))
+
+;;; A harder case: an approximate arglist is derived from available
+;;; debugging information.
+
+(defun debug-function-arglist (debug-function)
+  "Derive the argument list of DEBUG-FUNCTION from debug info."
+  (let ((args (di::debug-function-lambda-list debug-function))
+        (required '())
+        (optional '())
+        (rest '())
+        (key '()))
+    ;; collect the names of debug-vars
+    (dolist (arg args)
+      (etypecase arg
+        (di::debug-variable 
+         (push (di::debug-variable-symbol arg) required))
+        ((member :deleted)
+         (push ':deleted required))
+        (cons
+         (ecase (car arg)
+           (:keyword 
+            (push (second arg) key))
+           (:optional
+            (push (debug-variable-symbol-or-deleted (second arg)) optional))
+           (:rest 
+            (push (debug-variable-symbol-or-deleted (second arg)) rest))))))
+    ;; intersperse lambda keywords as needed
+    (append (nreverse required)
+            (if optional (cons '&optional (nreverse optional)))
+            (if rest (cons '&rest (nreverse rest)))
+            (if key (cons '&key (nreverse key))))))
+
+(defun debug-variable-symbol-or-deleted (var)
+  (etypecase var
+    (di:debug-variable
+     (di::debug-variable-symbol var))
+    ((member :deleted)
+     '#:deleted)))
+
+(defun symbol-debug-function-arglist (fname)
+  "Return FNAME's debug-function-arglist and %function-arglist.
+  A utility for debugging DEBUG-FUNCTION-ARGLIST."
+  (let ((fn (fdefinition fname)))
+    (values (debug-function-arglist (di::function-debug-function fn))
+            (kernel:%function-arglist (kernel:%function-self fn)))))
+
+;;; Deriving arglists for byte-compiled functions:
+;;;
+(defun byte-code-function-arglist (fn)
+  ;; There doesn't seem to be much arglist information around for
+  ;; byte-code functions.  Use the arg-count and return something like
+  ;; (arg0 arg1 ...)
+  (etypecase fn
+    (c::simple-byte-function 
+     (loop for i from 0 below (c::simple-byte-function-num-args fn)
+           collect (make-arg-symbol i)))
+    (c::hairy-byte-function 
+     (hairy-byte-function-arglist fn))
+    (c::byte-closure
+     (byte-code-function-arglist (c::byte-closure-function fn)))))
+
+(defun make-arg-symbol (i)
+  (make-symbol (format nil "~A~D" (string 'arg) i)))
+
+;;; A "hairy" byte-function is one that takes a variable number of
+;;; arguments. `hairy-byte-function' is a type from the bytecode
+;;; interpreter.
+;;;
+(defun hairy-byte-function-arglist (fn)
+  (let ((counter -1))
+    (flet ((next-arg () (make-arg-symbol (incf counter))))
+      (with-struct (c::hairy-byte-function- min-args max-args rest-arg-p
+                                            keywords-p keywords) fn
+        (let ((arglist '())
+              (optional (- max-args min-args)))
+          ;; XXX isn't there a better way to write this?
+          ;; (Looks fine to me. -luke)
+          (dotimes (i min-args)
+            (push (next-arg) arglist))
+          (when (plusp optional)
+            (push '&optional arglist)
+            (dotimes (i optional)
+              (push (next-arg) arglist)))
+          (when rest-arg-p
+            (push '&rest arglist)
+            (push (next-arg) arglist))
+          (when keywords-p
+            (push '&key arglist)
+            (loop for (key _ __) in keywords
+                  do (push key arglist))
+            (when (eq keywords-p :allow-others)
+              (push '&allow-other-keys arglist)))
+          (nreverse arglist))))))
+
+
+;;;; Miscellaneous.
+
+(defimplementation macroexpand-all (form)
+  (macroexpand form))
+
+(defimplementation set-default-directory (directory)
+  (setf (ext:default-directory) (namestring directory))
+  ;; Setting *default-pathname-defaults* to an absolute directory
+  ;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
+  (setf *default-pathname-defaults* (pathname (ext:default-directory)))
+  (default-directory))
+
+(defimplementation default-directory ()
+  (namestring (ext:default-directory)))
+
+(defimplementation call-without-interrupts (fn)
+  (funcall fn))
+
+(defimplementation getpid ()
+  (unix:unix-getpid))
+
+(defimplementation lisp-implementation-type-name ()
+  (if (eq ext:*case-mode* :upper) "scl" "scl-lower"))
+
+(defimplementation quit-lisp ()
+  (ext:quit))
+
+;;; source-path-{stream,file,string,etc}-position moved into 
+;;; swank-source-path-parser
+
+
+;;;; Debugging
+
+(defvar *sldb-stack-top*)
+
+(defimplementation call-with-debugging-environment (debugger-loop-fn)
+  (let* ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+	 (debug:*stack-top-hint* nil)
+         (kernel:*current-level* 0))
+    (handler-bind ((di::unhandled-condition
+		    (lambda (condition)
+                      (error (make-condition
+                              'sldb-condition
+                              :original-condition condition)))))
+      (funcall debugger-loop-fn))))
+
+(defun frame-down (frame)
+  (handler-case (di:frame-down frame)
+    (di:no-debug-info () nil)))
+
+(defun nth-frame (index)
+  (do ((frame *sldb-stack-top* (frame-down frame))
+       (i index (1- i)))
+      ((zerop i) frame)))
+
+(defimplementation compute-backtrace (start end)
+  (let ((end (or end most-positive-fixnum)))
+    (loop for f = (nth-frame start) then (frame-down f)
+	  for i from start below end
+	  while f
+	  collect f)))
+
+(defimplementation print-frame (frame stream)
+  (let ((*standard-output* stream))
+    (handler-case 
+        (debug::print-frame-call frame :verbosity 1 :number nil)
+      (error (e)
+        (ignore-errors (princ e stream))))))
+
+(defimplementation frame-source-location-for-emacs (index)
+  (code-location-source-location (di:frame-code-location (nth-frame index))))
+
+(defimplementation eval-in-frame (form index)
+  (di:eval-in-frame (nth-frame index) form))
+
+(defun frame-debug-vars (frame)
+  "Return a vector of debug-variables in frame."
+  (di::debug-function-debug-variables (di:frame-debug-function frame)))
+
+(defun debug-var-value (var frame location)
+  (let ((validity (di:debug-variable-validity var location)))
+    (ecase validity
+      (:valid (di:debug-variable-value var frame))
+      ((:invalid :unknown) (make-symbol (string validity))))))
+
+(defimplementation frame-locals (index)
+  (let* ((frame (nth-frame index))
+	 (loc (di:frame-code-location frame))
+	 (vars (frame-debug-vars frame)))
+    (loop for v across vars collect
+          (list :name (di:debug-variable-symbol v)
+                :id (di:debug-variable-id v)
+                :value (debug-var-value v frame loc)))))
+
+(defimplementation frame-var-value (frame var)
+  (let* ((frame (nth-frame frame))
+         (dvar (aref (frame-debug-vars frame) var)))
+    (debug-var-value dvar frame (di:frame-code-location frame))))
+
+(defimplementation frame-catch-tags (index)
+  (mapcar #'car (di:frame-catches (nth-frame index))))
+
+(defimplementation return-from-frame (index form)
+  (let ((sym (find-symbol (symbol-name '#:find-debug-tag-for-frame)
+                          :debug-internals)))
+    (if sym
+        (let* ((frame (nth-frame index))
+               (probe (funcall sym frame)))
+          (cond (probe (throw (car probe) (eval-in-frame form index)))
+                (t (format nil "Cannot return from frame: ~S" frame))))
+        "return-from-frame is not implemented in this version of SCL.")))
+
+(defimplementation activate-stepping (frame)
+  (set-step-breakpoints (nth-frame frame)))
+
+(defimplementation sldb-break-on-return (frame)
+  (break-on-return (nth-frame frame)))
+
+;;; We set the breakpoint in the caller which might be a bit confusing.
+;;;
+(defun break-on-return (frame)
+  (let* ((caller (di:frame-down frame))
+         (cl (di:frame-code-location caller)))
+    (flet ((hook (frame bp)
+             (when (frame-pointer= frame caller)
+               (di:delete-breakpoint bp)
+               (signal-breakpoint bp frame))))
+      (let* ((info (ecase (di:code-location-kind cl)
+                     ((:single-value-return :unknown-return) nil)
+                     (:known-return (debug-function-returns 
+                                     (di:frame-debug-function frame)))))
+             (bp (di:make-breakpoint #'hook cl :kind :code-location
+                                     :info info)))
+        (di:activate-breakpoint bp)
+        `(:ok ,(format nil "Set breakpoint in ~A" caller))))))
+
+(defun frame-pointer= (frame1 frame2)
+  "Return true if the frame pointers of FRAME1 and FRAME2 are the same."
+  (sys:sap= (di::frame-pointer frame1) (di::frame-pointer frame2)))
+
+;;; The PC in escaped frames at a single-return-value point is
+;;; actually vm:single-value-return-byte-offset bytes after the
+;;; position given in the debug info.  Here we try to recognize such
+;;; cases.
+;;;
+(defun next-code-locations (frame code-location)
+  "Like `debug::next-code-locations' but be careful in escaped frames."
+  (let ((next (debug::next-code-locations code-location)))
+    (flet ((adjust-pc ()
+             (let ((cl (di::copy-compiled-code-location code-location)))
+               (incf (di::compiled-code-location-pc cl) 
+                     vm:single-value-return-byte-offset)
+               cl)))
+      (cond ((and (di::compiled-frame-escaped frame)
+                  (eq (di:code-location-kind code-location)
+                      :single-value-return)
+                  (= (length next) 1)
+                  (di:code-location= (car next) (adjust-pc)))
+             (debug::next-code-locations (car next)))
+            (t
+             next)))))
+
+(defun set-step-breakpoints (frame)
+  (let ((cl (di:frame-code-location frame)))
+    (when (di:debug-block-elsewhere-p (di:code-location-debug-block cl))
+      (error "Cannot step in elsewhere code"))
+    (let* ((debug::*bad-code-location-types*
+            (remove :call-site debug::*bad-code-location-types*))
+           (next (next-code-locations frame cl)))
+      (cond (next
+             (let ((steppoints '()))
+               (flet ((hook (bp-frame bp)
+                        (signal-breakpoint bp bp-frame)
+                        (mapc #'di:delete-breakpoint steppoints)))
+                 (dolist (code-location next)
+                   (let ((bp (di:make-breakpoint #'hook code-location
+                                                 :kind :code-location)))
+                     (di:activate-breakpoint bp)
+                     (push bp steppoints))))))
+            (t
+             (break-on-return frame))))))
+
+
+;; XXX the return values at return breakpoints should be passed to the
+;; user hooks. debug-int.lisp should be changed to do this cleanly.
+
+;;; The sigcontext and the PC for a breakpoint invocation are not
+;;; passed to user hook functions, but we need them to extract return
+;;; values. So we advice di::handle-breakpoint and bind the values to
+;;; special variables.  
+;;;
+(defvar *breakpoint-sigcontext*)
+(defvar *breakpoint-pc*)
+
+(defun sigcontext-object (sc index)
+  "Extract the lisp object in sigcontext SC at offset INDEX."
+  (kernel:make-lisp-obj (vm:ucontext-register sc index)))
+
+(defun known-return-point-values (sigcontext sc-offsets)
+  (let ((fp (system:int-sap (vm:ucontext-register sigcontext
+                                                  vm::cfp-offset))))
+    (system:without-gcing
+     (loop for sc-offset across sc-offsets
+           collect (di::sub-access-debug-var-slot fp sc-offset sigcontext)))))
+
+;;; SCL returns the first few values in registers and the rest on
+;;; the stack. In the multiple value case, the number of values is
+;;; stored in a dedicated register. The values of the registers can be
+;;; accessed in the sigcontext for the breakpoint.  There are 3 kinds
+;;; of return conventions: :single-value-return, :unknown-return, and
+;;; :known-return.
+;;;
+;;; The :single-value-return convention returns the value in a
+;;; register without setting the nargs registers.  
+;;;
+;;; The :unknown-return variant is used for multiple values. A
+;;; :unknown-return point consists actually of 2 breakpoints: one for
+;;; the single value case and one for the general case.  The single
+;;; value breakpoint comes vm:single-value-return-byte-offset after
+;;; the multiple value breakpoint.
+;;;
+;;; The :known-return convention is used by local functions.
+;;; :known-return is currently not supported because we don't know
+;;; where the values are passed.
+;;;
+(defun breakpoint-values (breakpoint)
+  "Return the list of return values for a return point."
+  (flet ((1st (sc) (sigcontext-object sc (car vm::register-arg-offsets))))
+    (let ((sc (locally (declare (optimize (ext:inhibit-warnings 3)))
+                (alien:sap-alien *breakpoint-sigcontext* (* unix:ucontext))))
+          (cl (di:breakpoint-what breakpoint)))
+      (ecase (di:code-location-kind cl)
+        (:single-value-return
+         (list (1st sc)))
+        (:known-return
+         (let ((info (di:breakpoint-info breakpoint)))
+           (if (vectorp info)
+               (known-return-point-values sc info)
+               (progn 
+                 ;;(break)
+                 (list "<<known-return convention not supported>>" info)))))
+        (:unknown-return
+         (let ((mv-return-pc (di::compiled-code-location-pc cl)))
+           (if (= mv-return-pc *breakpoint-pc*)
+               (mv-function-end-breakpoint-values sc)
+               (list (1st sc)))))))))
+
+(defun mv-function-end-breakpoint-values (sigcontext)
+  (let ((sym (find-symbol (symbol-name '#:function-end-breakpoint-values/standard)
+                          :debug-internals)))
+    (cond (sym (funcall sym sigcontext))
+          (t (di::get-function-end-breakpoint-values sigcontext)))))
+
+(defun debug-function-returns (debug-fun)
+  "Return the return style of DEBUG-FUN."
+  (let* ((cdfun (di::compiled-debug-function-compiler-debug-fun debug-fun)))
+    (c::compiled-debug-function-returns cdfun)))
+
+(define-condition breakpoint (simple-condition) 
+  ((message :initarg :message :reader breakpoint.message)
+   (values  :initarg :values  :reader breakpoint.values))
+  (:report (lambda (c stream) (princ (breakpoint.message c) stream))))
+
+#+nil
+(defimplementation condition-extras ((c breakpoint))
+  ;; simply pop up the source buffer
+  `((:short-frame-source 0)))
+
+(defun signal-breakpoint (breakpoint frame)
+  "Signal a breakpoint condition for BREAKPOINT in FRAME.
+Try to create a informative message."
+  (flet ((brk (values fstring &rest args)
+           (let ((msg (apply #'format nil fstring args))
+                 (debug:*stack-top-hint* frame))
+             (break 'breakpoint :message msg :values values))))
+    (with-struct (di::breakpoint- kind what) breakpoint
+      (case kind
+        (:code-location
+         (case (di:code-location-kind what)
+           ((:single-value-return :known-return :unknown-return)
+            (let ((values (breakpoint-values breakpoint)))
+              (brk values "Return value: ~{~S ~}" values)))
+           (t
+            #+(or)
+            (when (eq (di:code-location-kind what) :call-site)
+              (call-site-function breakpoint frame))
+            (brk nil "Breakpoint: ~S ~S" 
+                 (di:code-location-kind what)
+                 (di::compiled-code-location-pc what)))))
+        (:function-start
+         (brk nil "Function start breakpoint"))
+        (t (brk nil "Breakpoint: ~A in ~A" breakpoint frame))))))
+
+#+nil
+(defimplementation sldb-break-at-start (fname)
+  (let ((debug-fun (di:function-debug-function (coerce fname 'function))))
+    (cond ((not debug-fun)
+           `(:error ,(format nil "~S has no debug-function" fname)))
+          (t
+           (flet ((hook (frame bp &optional args cookie)
+                    (declare (ignore args cookie))
+                    (signal-breakpoint bp frame)))
+             (let ((bp (di:make-breakpoint #'hook debug-fun
+                                           :kind :function-start)))
+               (di:activate-breakpoint bp)
+               `(:ok ,(format nil "Set breakpoint in ~S" fname))))))))
+
+(defun frame-cfp (frame)
+  "Return the Control-Stack-Frame-Pointer for FRAME."
+  (etypecase frame
+    (di::compiled-frame (di::frame-pointer frame))
+    ((or di::interpreted-frame null) -1)))
+
+(defun frame-ip (frame)
+  "Return the (absolute) instruction pointer and the relative pc of FRAME."
+  (if (not frame)
+      -1
+      (let ((debug-fun (di::frame-debug-function frame)))
+        (etypecase debug-fun
+          (di::compiled-debug-function 
+           (let* ((code-loc (di:frame-code-location frame))
+                  (component (di::compiled-debug-function-component debug-fun))
+                  (pc (di::compiled-code-location-pc code-loc))
+                  (ip (sys:without-gcing
+                       (sys:sap-int
+                        (sys:sap+ (kernel:code-instructions component) pc)))))
+             (values ip pc)))
+          ((or di::bogus-debug-function di::interpreted-debug-function)
+           -1)))))
+
+(defun frame-registers (frame)
+  "Return the lisp registers CSP, CFP, IP, OCFP, LRA for FRAME-NUMBER."
+  (let* ((cfp (frame-cfp frame))
+         (csp (frame-cfp (di::frame-up frame)))
+         (ip (frame-ip frame))
+         (ocfp (frame-cfp (di::frame-down frame)))
+         (lra (frame-ip (di::frame-down frame))))
+    (values csp cfp ip ocfp lra)))
+
+(defun print-frame-registers (frame-number)
+  (let ((frame (di::frame-real-frame (nth-frame frame-number))))
+    (flet ((fixnum (p) (etypecase p
+                         (integer p)
+                         (sys:system-area-pointer (sys:sap-int p)))))
+      (apply #'format t "~
+CSP  =  ~X
+CFP  =  ~X
+IP   =  ~X
+OCFP =  ~X
+LRA  =  ~X~%" (mapcar #'fixnum 
+                      (multiple-value-list (frame-registers frame)))))))
+
+
+(defimplementation disassemble-frame (frame-number)
+  "Return a string with the disassembly of frames code."
+  (print-frame-registers frame-number)
+  (terpri)
+  (let* ((frame (di::frame-real-frame (nth-frame frame-number)))
+         (debug-fun (di::frame-debug-function frame)))
+    (etypecase debug-fun
+      (di::compiled-debug-function
+       (let* ((component (di::compiled-debug-function-component debug-fun))
+              (fun (di:debug-function-function debug-fun)))
+         (if fun
+             (disassemble fun)
+             (disassem:disassemble-code-component component))))
+      (di::bogus-debug-function
+       (format t "~%[Disassembling bogus frames not implemented]")))))
+
+
+;;;; Inspecting
+
+(defclass scl-inspector (backend-inspector) ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'scl-inspector))
+
+(defconstant +lowtag-symbols+ 
+  '(vm:even-fixnum-type
+    vm:instance-pointer-type
+    vm:other-immediate-0-type
+    vm:list-pointer-type
+    vm:odd-fixnum-type
+    vm:function-pointer-type
+    vm:other-immediate-1-type
+    vm:other-pointer-type)
+  "Names of the constants that specify type tags.
+The `symbol-value' of each element is a type tag.")
+
+(defconstant +header-type-symbols+
+  (labels ((suffixp (suffix string)
+             (and (>= (length string) (length suffix))
+                  (string= string suffix :start1 (- (length string) 
+                                                    (length suffix)))))
+           (header-type-symbol-p (x)
+             (and (suffixp (symbol-name '#:-type) (symbol-name x))
+                  (not (member x +lowtag-symbols+))
+                  (boundp x)
+                  (typep (symbol-value x) 'fixnum))))
+    (remove-if-not #'header-type-symbol-p
+                   (append (apropos-list (symbol-name '#:-type) :vm)
+                           (apropos-list (symbol-name '#:-type) :bignum))))
+  "A list of names of the type codes in boxed objects.")
+
+(defimplementation describe-primitive-type (object)
+  (with-output-to-string (*standard-output*)
+    (let* ((lowtag (kernel:get-lowtag object))
+	   (lowtag-symbol (find lowtag +lowtag-symbols+ :key #'symbol-value)))
+      (format t "lowtag: ~A" lowtag-symbol)
+      (when (member lowtag (list vm:other-pointer-type
+                                 vm:function-pointer-type
+                                 vm:other-immediate-0-type
+                                 vm:other-immediate-1-type
+                                 ))
+        (let* ((type (kernel:get-type object))
+               (type-symbol (find type +header-type-symbols+
+                                  :key #'symbol-value)))
+          (format t ", type: ~A" type-symbol))))))
+
+(defmethod inspect-for-emacs ((o t) (inspector backend-inspector))
+  (cond ((di::indirect-value-cell-p o)
+         (values (format nil "~A is a value cell." o)
+                 `("Value: " (:value ,(c:value-cell-ref o)))))
+        ((alien::alien-value-p o)
+         (inspect-alien-value o))
+	(t
+         (scl-inspect o))))
+
+(defun scl-inspect (o)
+  (destructuring-bind (text labeledp . parts)
+      (inspect::describe-parts o)
+    (values (format nil "~A~%" text)
+            (if labeledp
+                (loop for (label . value) in parts
+                      append (label-value-line label value))
+                (loop for value in parts  for i from 0 
+                      append (label-value-line i value))))))
+
+(defmethod inspect-for-emacs ((o function) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (let ((header (kernel:get-type o)))
+    (cond ((= header vm:function-header-type)
+           (values (format nil "~A is a function." o)
+                   (append (label-value-line*
+                            ("Self" (kernel:%function-self o))
+                            ("Next" (kernel:%function-next o))
+                            ("Name" (kernel:%function-name o))
+                            ("Arglist" (kernel:%function-arglist o))
+                            ("Type" (kernel:%function-type o))
+                            ("Code" (kernel:function-code-header o)))
+                           (list 
+                            (with-output-to-string (s)
+                              (disassem:disassemble-function o :stream s))))))
+          ((= header vm:closure-header-type)
+           (values (format nil "~A is a closure" o)
+                   (append 
+                    (label-value-line "Function" (kernel:%closure-function o))
+                    `("Environment:" (:newline))
+                    (loop for i from 0 below (- (kernel:get-closure-length o)
+                                                (1- vm:closure-info-offset))
+                          append (label-value-line 
+                                  i (kernel:%closure-index-ref o i))))))
+          ((eval::interpreted-function-p o)
+           (scl-inspect o))
+          (t
+           (call-next-method)))))
+
+
+(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector))
+  (declare (ignore _))
+  (values (format nil "~A is a code data-block." o)
+          (append 
+           (label-value-line* 
+            ("code-size" (kernel:%code-code-size o))
+            ("entry-points" (kernel:%code-entry-points o))
+            ("debug-info" (kernel:%code-debug-info o))
+            ("trace-table-offset" (kernel:code-header-ref 
+                                   o vm:code-trace-table-offset-slot)))
+           `("Constants:" (:newline))
+           (loop for i from vm:code-constants-offset 
+                 below (kernel:get-header-data o)
+                 append (label-value-line i (kernel:code-header-ref o i)))
+           `("Code:" (:newline)
+             , (with-output-to-string (s)
+                 (cond ((kernel:%code-debug-info o)
+                        (disassem:disassemble-code-component o :stream s))
+                       (t
+                        (disassem:disassemble-memory 
+                         (disassem::align 
+                          (+ (logandc2 (kernel:get-lisp-obj-address o)
+                                       vm:lowtag-mask)
+                             (* vm:code-constants-offset vm:word-bytes))
+                          (ash 1 vm:lowtag-bits))
+                         (ash (kernel:%code-code-size o) vm:word-shift)
+                         :stream s))))))))
+
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector))
+  (declare (ignore inspector))
+  (values (format nil "~A is a fdenf object." o)
+          (label-value-line*
+           ("name" (kernel:fdefn-name o))
+           ("function" (kernel:fdefn-function o))
+           ("raw-addr" (sys:sap-ref-32
+                        (sys:int-sap (kernel:get-lisp-obj-address o))
+                        (* vm:fdefn-raw-addr-slot vm:word-bytes))))))
+
+(defmethod inspect-for-emacs ((o array) (inspector backend-inspector))
+  inspector
+  (cond ((kernel:array-header-p o)
+         (values (format nil "~A is an array." o)
+                 (label-value-line*
+                  (:header (describe-primitive-type o))
+                  (:rank (array-rank o))
+                  (:fill-pointer (kernel:%array-fill-pointer o))
+                  (:fill-pointer-p (kernel:%array-fill-pointer-p o))
+                  (:elements (kernel:%array-available-elements o))           
+                  (:data (kernel:%array-data-vector o))
+                  (:displacement (kernel:%array-displacement o))
+                  (:displaced-p (kernel:%array-displaced-p o))
+                  (:dimensions (array-dimensions o)))))
+        (t
+         (values (format nil "~A is an simple-array." o)
+                 (label-value-line*
+                  (:header (describe-primitive-type o))
+                  (:length (length o)))))))
+
+(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector))
+  inspector
+  (values (format nil "~A is a vector." o)
+          (append 
+           (label-value-line*
+            (:header (describe-primitive-type o))
+            (:length (c::vector-length o)))
+           (unless (eq (array-element-type o) 'nil)
+             (loop for i below (length o)
+                   append (label-value-line i (aref o i)))))))
+
+(defun inspect-alien-record (alien)
+  (values
+   (format nil "~A is an alien value." alien)
+   (with-struct (alien::alien-value- sap type) alien
+     (with-struct (alien::alien-record-type- kind name fields) type
+       (append
+        (label-value-line*
+         (:sap sap)
+         (:kind kind)
+         (:name name))
+        (loop for field in fields 
+              append (let ((slot (alien::alien-record-field-name field)))
+                       (label-value-line slot (alien:slot alien slot)))))))))
+
+(defun inspect-alien-pointer (alien)
+  (values
+   (format nil "~A is an alien value." alien)
+   (with-struct (alien::alien-value- sap type) alien
+     (label-value-line* 
+      (:sap sap)
+      (:type type)
+      (:to (alien::deref alien))))))
+  
+(defun inspect-alien-value (alien)
+  (typecase (alien::alien-value-type alien)
+    (alien::alien-record-type (inspect-alien-record alien))
+    (alien::alien-pointer-type (inspect-alien-pointer alien))
+    (t (scl-inspect alien))))
+
+;;;; Profiling
+(defimplementation profile (fname)
+  (eval `(profile:profile ,fname)))
+
+(defimplementation unprofile (fname)
+  (eval `(profile:unprofile ,fname)))
+
+(defimplementation unprofile-all ()
+  (eval `(profile:unprofile))
+  "All functions unprofiled.")
+
+(defimplementation profile-report ()
+  (eval `(profile:report-time)))
+
+(defimplementation profile-reset ()
+  (eval `(profile:reset-time))
+  "Reset profiling counters.")
+
+(defimplementation profiled-functions ()
+  profile:*timed-functions*)
+
+(defimplementation profile-package (package callers methods)
+  (profile:profile-all :package package
+                       :callers-p callers
+                       #+nil :methods #+nil methods))
+
+
+;;;; Multiprocessing
+
+(defimplementation spawn (fn &key name)
+  (thread:thread-create fn :name (or name "Anonymous")))
+
+(defvar *thread-id-counter* 0)
+(defvar *thread-id-counter-lock* (thread:make-lock "Thread ID counter"))
+
+(defimplementation thread-id (thread)
+  (thread:with-lock-held (*thread-id-counter-lock*)
+    (or (getf (thread:thread-plist thread) 'id)
+        (setf (getf (thread:thread-plist thread) 'id)
+              (incf *thread-id-counter*)))))
+
+(defimplementation find-thread (id)
+  (block find-thread
+    (thread:map-over-threads
+     #'(lambda (thread)
+         (when (eql (getf (thread:thread-plist thread) 'id) id)
+           (return-from find-thread thread))))))
+
+(defimplementation thread-name (thread)
+  (princ-to-string (thread:thread-name thread)))
+
+(defimplementation thread-status (thread)
+  (let ((dynamic-values (thread::thread-dynamic-values thread)))
+    (if (zerop dynamic-values) "Exited" "Running")))
+
+(defimplementation make-lock (&key name)
+  (thread:make-lock name))
+
+(defimplementation call-with-lock-held (lock function)
+  (declare (type function function))
+  (thread:with-lock-held (lock) (funcall function)))
+
+(defimplementation current-thread ()
+  thread:*thread*)
+
+(defimplementation all-threads ()
+  (let ((all-threads nil))
+    (thread:map-over-threads #'(lambda (thread) (push thread all-threads)))
+    all-threads))
+
+(defimplementation interrupt-thread (thread fn)
+  (thread:thread-interrupt thread #'(lambda ()
+                                      (sys:with-interrupts
+                                        (funcall fn)))))
+
+(defimplementation kill-thread (thread)
+  (thread:destroy-thread thread))
+
+(defimplementation thread-alive-p (thread)
+  (not (zerop (thread::thread-dynamic-values thread))))
+
+(defvar *mailbox-lock* (thread:make-lock "Mailbox lock"))
+  
+(defstruct (mailbox)
+  (lock (thread:make-lock "Thread mailbox" :type :error-check
+                          :interruptible nil)
+        :type thread:error-check-lock)
+  (queue '() :type list))
+
+(defun mailbox (thread)
+  "Return 'thread's mailbox."
+  (thread:with-lock-held (*mailbox-lock*)
+    (or (getf (thread:thread-plist thread) 'mailbox)
+        (setf (getf (thread:thread-plist thread) 'mailbox) (make-mailbox)))))
+  
+(defimplementation send (thread message)
+  (let* ((mbox (mailbox thread))
+         (lock (mailbox-lock mbox)))
+    (sys:without-interrupts
+      (thread:with-lock-held (lock "Mailbox Send")
+        (setf (mailbox-queue mbox) (nconc (mailbox-queue mbox)
+                                          (list message)))))
+    (mp:process-wakeup thread)
+    message))
+  
+(defimplementation receive ()
+  (let* ((mbox (mailbox thread:*thread*))
+         (lock (mailbox-lock mbox)))
+    (loop
+     (mp:process-wait-with-timeout "Mailbox read wait" 1
+                                   #'(lambda () (mailbox-queue mbox)))
+     (multiple-value-bind (message winp)
+	 (sys:without-interrupts
+           (mp:with-lock-held (lock "Mailbox read")
+             (let ((queue (mailbox-queue mbox)))
+               (cond (queue
+                      (setf (mailbox-queue mbox) (cdr queue))
+                      (values (car queue) t))
+                     (t
+                      (values nil nil))))))
+       (when winp
+         (return message))))))
+
+
+
+(defimplementation emacs-connected ())
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;Trace implementations
+;; In SCL, we have:
+;;  (trace <name>)
+;;  (trace (method <name> <qualifier>? (<specializer>+)))
+;;  (trace :methods t '<name>) ;;to trace all methods of the gf <name>
+;;  <name> can be a normal name or a (setf name)
+
+(defun tracedp (spec)
+  (member spec (eval '(trace)) :test #'equal))
+
+(defun toggle-trace-aux (spec &rest options)
+  (cond ((tracedp spec)
+         (eval `(untrace ,spec))
+         (format nil "~S is now untraced." spec))
+        (t
+         (eval `(trace ,spec , at options))
+         (format nil "~S is now traced." spec))))
+
+(defimplementation toggle-trace (spec)
+  (ecase (car spec)
+    ((setf)
+     (toggle-trace-aux spec))
+    ((:defgeneric)
+     (let ((name (second spec)))
+       (toggle-trace-aux name :methods name)))
+    ((:defmethod)
+     nil)
+    ((:call)
+     (destructuring-bind (caller callee) (cdr spec)
+       (toggle-trace-aux (process-fspec callee) 
+                         :wherein (list (process-fspec caller)))))))
+
+(defun process-fspec (fspec)
+  (cond ((consp fspec)
+         (ecase (first fspec)
+           ((:defun :defgeneric) (second fspec))
+           ((:defmethod) 
+            `(method ,(second fspec) ,@(third fspec) ,(fourth fspec)))
+           ;; this isn't actually supported
+           ((:labels) `(labels ,(process-fspec (second fspec)) ,(third fspec)))
+           ((:flet) `(flet ,(process-fspec (second fspec)) ,(third fspec)))))
+        (t
+         fspec)))
+
+;;; Weak datastructures
+
+;;; Not implemented in SCL.
+(defimplementation make-weak-key-hash-table (&rest args)
+  (apply #'make-hash-table :weak-p t args))
+
+;; Local Variables:
+;; pbook-heading-regexp:    "^;;;\\(;+\\)"
+;; pbook-commentary-regexp: "^;;;\\($\\|[^;]\\)"
+;; End:

Added: branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-source-file-cache.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,118 @@
+;;;; Source-file cache
+;;;
+;;; To robustly find source locations in CMUCL and SBCL it's useful to
+;;; have the exact source code that the loaded code was compiled from.
+;;; In this source we can accurately find the right location, and from
+;;; that location we can extract a "snippet" of code to show what the
+;;; definition looks like. Emacs can use this snippet in a best-match
+;;; search to locate the right definition, which works well even if
+;;; the buffer has been modified.
+;;;
+;;; The idea is that if a definition previously started with
+;;; `(define-foo bar' then it probably still does.
+;;;
+;;; Whenever we see that the file on disk has the same
+;;; `file-write-date' as a location we're looking for we cache the
+;;; whole file inside Lisp. That way we will still have the matching
+;;; version even if the file is later modified on disk. If the file is
+;;; later recompiled and reloaded then we replace our cache entry.
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+
+(in-package :swank-backend)
+
+(defvar *cache-sourcecode* t
+  "When true complete source files are cached.
+The cache is used to keep known good copies of the source text which
+correspond to the loaded code. Finding definitions is much more
+reliable when the exact source is available, so we cache it in case it
+gets edited on disk later.")
+
+(defvar *source-file-cache* (make-hash-table :test 'equal)
+  "Cache of source file contents.
+Maps from truename to source-cache-entry structure.")
+
+(defstruct (source-cache-entry
+             (:conc-name source-cache-entry.)
+             (:constructor make-source-cache-entry (text date)))
+  text date)
+
+(defimplementation buffer-first-change (filename)
+  "Load a file into the cache when the user modifies its buffer.
+This is a win if the user then saves the file and tries to M-. into it."
+  (unless (source-cached-p filename)
+    (ignore-errors
+      (source-cache-get filename (file-write-date filename))))
+  nil)
+
+(defun get-source-code (filename code-date)
+  "Return the source code for FILENAME as written on DATE in a string.
+If the exact version cannot be found then return the current one from disk."
+  (or (source-cache-get filename code-date)
+      (read-file filename)))
+
+(defun source-cache-get (filename date)
+  "Return the source code for FILENAME as written on DATE in a string.
+Return NIL if the right version cannot be found."
+  (when *cache-sourcecode*
+    (let ((entry (gethash filename *source-file-cache*)))
+      (cond ((and entry (equal date (source-cache-entry.date entry)))
+             ;; Cache hit.
+             (source-cache-entry.text entry))
+            ((or (null entry)
+                 (not (equal date (source-cache-entry.date entry))))
+             ;; Cache miss.
+             (if (equal (file-write-date filename) date)
+                 ;; File on disk has the correct version.
+                 (let ((source (read-file filename)))
+                   (setf (gethash filename *source-file-cache*)
+                         (make-source-cache-entry source date))
+                   source)
+                 nil))))))
+
+(defun source-cached-p (filename)
+  "Is any version of FILENAME in the source cache?"
+  (if (gethash filename *source-file-cache*) t))
+
+(defun read-file (filename)
+  "Return the entire contents of FILENAME as a string."
+  (with-open-file (s filename :direction :input
+		     :external-format (or (guess-external-format filename)
+					  (find-external-format "latin-1")
+					  :default))
+    (let ((string (make-string (file-length s))))
+      (read-sequence string s)
+      string)))
+
+;;;; Snippets
+
+(defvar *source-snippet-size* 256
+  "Maximum number of characters in a snippet of source code.
+Snippets at the beginning of definitions are used to tell Emacs what
+the definitions looks like, so that it can accurately find them by
+text search.")
+
+(defun read-snippet (stream &optional position)
+  "Read a string of upto *SOURCE-SNIPPET-SIZE* characters from STREAM.
+If POSITION is given, set the STREAM's file position first."
+  (when position
+    (file-position stream position))
+  #+SBCL (skip-comments-and-whitespace stream)
+  (read-upto-n-chars stream *source-snippet-size*))
+
+(defun skip-comments-and-whitespace (stream)
+  (case (peek-char nil stream)
+    ((#\Space #\Tab #\Newline #\Linefeed)
+     (read-char stream)
+     (skip-comments-and-whitespace stream))
+    (#\;
+     (read-line stream)
+     (skip-comments-and-whitespace stream))))
+
+(defun read-upto-n-chars (stream n)
+  "Return a string of upto N chars from STREAM."
+  (let* ((string (make-string n))
+         (chars  (read-sequence string stream)))
+    (subseq string 0 chars)))
+

Added: branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,131 @@
+;;;; Source-paths
+
+;;; CMUCL/SBCL use a data structure called "source-path" to locate
+;;; subforms.  The compiler assigns a source-path to each form in a
+;;; compilation unit.  Compiler notes usually contain the source-path
+;;; of the error location.
+;;;
+;;; Compiled code objects don't contain source paths, only the
+;;; "toplevel-form-number" and the (sub-) "form-number".  To get from
+;;; the form-number to the source-path we need the entire toplevel-form
+;;; (i.e. we have to read the source code).  CMUCL has already some
+;;; utilities to do this translation, but we use some extended
+;;; versions, because we need more exact position info.  Apparently
+;;; Hemlock is happy with the position of the toplevel-form; we also
+;;; need the position of subforms.
+;;;
+;;; We use a special readtable to get the positions of the subforms.
+;;; The readtable stores the start and end position for each subform in
+;;; hashtable for later retrieval.
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+
+;;; Taken from swank-cmucl.lisp, by Helmut Eller
+
+(in-package :swank-backend)
+
+;; Some test to ensure the required conformance
+(let ((rt (copy-readtable nil)))
+  (assert (or (not (get-macro-character #\space rt))
+	      (nth-value 1 (get-macro-character #\space rt))))
+  (assert (not (get-macro-character #\\ rt))))
+
+(defun make-source-recorder (fn source-map)
+  "Return a macro character function that does the same as FN, but
+additionally stores the result together with the stream positions
+before and after of calling FN in the hashtable SOURCE-MAP."
+  (declare (type function fn))
+  (lambda (stream char)
+    (let ((start (file-position stream))
+	  (values (multiple-value-list (funcall fn stream char)))
+	  (end (file-position stream)))
+      ;;(format t "[~D ~{~A~^, ~} ~D ~D]~%" start values end (char-code char))
+      (unless (null values)
+	(push (cons start end) (gethash (car values) source-map)))
+      (values-list values))))
+
+(defun make-source-recording-readtable (readtable source-map) 
+  "Return a source position recording copy of READTABLE.
+The source locations are stored in SOURCE-MAP."
+  (let* ((tab (copy-readtable readtable))
+	 (*readtable* tab))
+    (dotimes (code 128)
+      (let ((char (code-char code)))
+	(multiple-value-bind (fn term) (get-macro-character char tab)
+	  (when fn
+	    (set-macro-character char (make-source-recorder fn source-map) 
+				 term tab)))))
+    (suppress-sharp-dot tab)
+    tab))
+
+(defun suppress-sharp-dot (readtable)
+  (when (get-macro-character #\# readtable)
+    (let ((sharp-dot (get-dispatch-macro-character #\# #\. readtable)))
+      (set-dispatch-macro-character #\# #\. (lambda (&rest args)
+					      (let ((*read-suppress* t))
+						(apply sharp-dot args))
+					      (if *read-suppress*
+						  (values)
+						  (list (gensym "#."))))
+				    readtable))))
+
+(defun read-and-record-source-map (stream)
+  "Read the next object from STREAM.
+Return the object together with a hashtable that maps
+subexpressions of the object to stream positions."
+  (let* ((source-map (make-hash-table :test #'eq))
+         (*readtable* (make-source-recording-readtable *readtable* source-map))
+	 (start (file-position stream))
+	 (form (read stream))
+	 (end (file-position stream)))
+    ;; ensure that at least FORM is in the source-map
+    (unless (gethash form source-map)
+      (push (cons start end) (gethash form source-map)))
+    (values form source-map)))
+
+(defun read-source-form (n stream)
+  "Read the Nth toplevel form number with source location recording.
+Return the form and the source-map."
+  (let ((*read-suppress* t))
+    (dotimes (i n)
+      (read stream)))
+  (let ((*read-suppress* nil)
+	(*read-eval* nil))
+    (read-and-record-source-map stream)))
+  
+(defun source-path-stream-position (path stream)
+  "Search the source-path PATH in STREAM and return its position."
+  (check-source-path path)
+  (destructuring-bind (tlf-number . path) path
+    (multiple-value-bind (form source-map) (read-source-form tlf-number stream)
+      (source-path-source-position (cons 0 path) form source-map))))
+
+(defun check-source-path (path)
+  (unless (and (consp path)
+               (every #'integerp path))
+    (error "The source-path ~S is not valid." path)))
+
+(defun source-path-string-position (path string)
+  (with-input-from-string (s string)
+    (source-path-stream-position path s)))
+
+(defun source-path-file-position (path filename)
+  (with-open-file (file filename)
+    (source-path-stream-position path file)))
+
+(defun source-path-source-position (path form source-map)
+  "Return the start position of PATH from FORM and SOURCE-MAP.  All
+subforms along the path are considered and the start and end position
+of the deepest (i.e. smallest) possible form is returned."
+  ;; compute all subforms along path
+  (let ((forms (loop for n in path
+		     for f = form then (nth n f)
+		     collect f)))
+    ;; select the first subform present in source-map
+    (loop for form in (reverse forms)
+	  for positions = (gethash form source-map)
+	  until (and positions (null (cdr positions)))
+	  finally (destructuring-bind ((start . end)) positions
+		    (return (values (1- start) end))))))
+

Added: branches/trunk-reorg/thirdparty/slime/swank.asd
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank.asd	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank.asd	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,48 @@
+;;; -*- lisp -*-
+
+;; ASDF system definition for loading the Swank server independently
+;; of Emacs.
+;;
+;; This is only useful if you want to start a Swank server in a Lisp
+;; processes that doesn't run under Emacs. Lisp processes created by
+;; `M-x slime' automatically start the server.
+
+;; Usage:
+;;
+;;   (require :swank)
+;;   (swank:create-swank-server PORT) => ACTUAL-PORT
+;;
+;; (PORT can be zero to mean "any available port".)
+;; Then the Swank server is running on localhost:ACTUAL-PORT. You can
+;; use `M-x slime-connect' to connect Emacs to it.
+;;
+;; This code has been placed in the Public Domain.  All warranties
+;; are disclaimed.
+
+(defpackage :swank-loader
+  (:use :cl))
+
+(in-package :swank-loader)
+
+(defclass cl-script-file (asdf:source-file) ())
+
+(defmethod asdf:perform ((o asdf:compile-op) (f cl-script-file))
+  t)
+(defmethod asdf:perform ((o asdf:load-op) (f cl-script-file))
+  (mapcar #'load (asdf:input-files o f)))
+(defmethod asdf:output-files ((o asdf:compile-op) (f cl-script-file))
+  nil)
+(defmethod asdf:input-files ((o asdf:load-op) (c cl-script-file))
+  (list (asdf:component-pathname c)))
+(defmethod asdf:operation-done-p ((o asdf:compile-op) (c cl-script-file))
+  t)
+(defmethod asdf:source-file-type ((c cl-script-file) (s asdf:module))
+  "lisp")
+
+(asdf:defsystem :swank
+    :default-component-class cl-script-file
+    :components ((:file "swank-loader")))
+
+(defparameter *source-directory*
+  (asdf:component-pathname (asdf:find-system :swank)))
+

Added: branches/trunk-reorg/thirdparty/slime/swank.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/swank.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/swank.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,3198 @@
+;;; -*- outline-regexp:";;;;;*" indent-tabs-mode:nil coding:latin-1-unix -*-
+;;;
+;;; This code has been placed in the Public Domain.  All warranties
+;;; are disclaimed.
+;;;
+;;;; swank.lisp
+;;;
+;;; This file defines the "Swank" TCP server for Emacs to talk to. The
+;;; code in this file is purely portable Common Lisp. We do require a
+;;; smattering of non-portable functions in order to write the server,
+;;; so we have defined them in `swank-backend.lisp' and implemented
+;;; them separately for each Lisp implementation. These extensions are
+;;; available to us here via the `SWANK-BACKEND' package.
+
+(defpackage :swank
+  (:use :common-lisp :swank-backend)
+  (:export #:startup-multiprocessing
+           #:start-server 
+           #:create-server
+           #:ed-in-emacs
+           #:inspect-in-emacs
+           #:print-indentation-lossage
+           #:swank-debugger-hook
+           #:run-after-init-hook
+           #:inspect-for-emacs
+           #:inspect-slot-for-emacs
+           ;; These are user-configurable variables:
+           #:*communication-style*
+           #:*dont-close*
+           #:*log-events*
+           #:*log-output*
+           #:*use-dedicated-output-stream*
+           #:*dedicated-output-stream-port*
+           #:*configure-emacs-indentation*
+           #:*readtable-alist*
+           #:*globally-redirect-io*
+           #:*global-debugger*
+           #:*sldb-printer-bindings*
+           #:*swank-pprint-bindings*
+           #:*default-worker-thread-bindings*
+           #:*macroexpand-printer-bindings*
+           #:*record-repl-results*
+           #:*debug-on-swank-error*
+           ;; These are re-exported directly from the backend:
+           #:buffer-first-change
+           #:frame-source-location-for-emacs
+           #:restart-frame
+           #:sldb-step
+           #:sldb-break
+           #:sldb-break-on-return
+           #:profiled-functions
+           #:profile-report
+           #:profile-reset
+           #:unprofile-all
+           #:profile-package
+           #:default-directory
+           #:set-default-directory
+           #:quit-lisp))
+
+(in-package :swank)
+
+
+;;;; Top-level variables, constants, macros
+
+(defconstant cl-package (find-package :cl)
+  "The COMMON-LISP package.")
+
+(defconstant keyword-package (find-package :keyword)
+  "The KEYWORD package.")
+
+(defvar *canonical-package-nicknames*
+  `((:common-lisp-user . :cl-user))
+  "Canonical package names to use instead of shortest name/nickname.")
+
+(defvar *auto-abbreviate-dotted-packages* t
+  "Abbreviate dotted package names to their last component if T.")
+
+(defvar *swank-io-package*
+  (let ((package (make-package :swank-io-package :use '())))
+    (import '(nil t quote) package)
+    package))
+
+(defconstant default-server-port 4005
+  "The default TCP port for the server (when started manually).")
+
+(defvar *swank-debug-p* t
+  "When true, print extra debugging information.")
+
+(defvar *redirect-io* t
+  "When non-nil redirect Lisp standard I/O to Emacs.
+Redirection is done while Lisp is processing a request for Emacs.")
+
+(defvar *sldb-printer-bindings*
+  `((*print-pretty*           . t)
+    (*print-level*            . 4)
+    (*print-length*           . 10)
+    (*print-circle*           . t)
+    (*print-readably*         . nil)
+    (*print-pprint-dispatch*  . ,(copy-pprint-dispatch nil))
+    (*print-gensym*           . t)
+    (*print-base*             . 10)
+    (*print-radix*            . nil)
+    (*print-array*            . t)
+    (*print-lines*            . 10)
+    (*print-escape*           . t)
+    (*print-right-margin*     . 70))
+  "A set of printer variables used in the debugger.")
+
+(defvar *default-worker-thread-bindings* '()
+  "An alist to initialize dynamic variables in worker threads.  
+The list has the form ((VAR . VALUE) ...).  Each variable VAR will be
+bound to the corresponding VALUE.")
+
+(defun call-with-bindings (alist fun)
+  "Call FUN with variables bound according to ALIST.
+ALIST is a list of the form ((VAR . VAL) ...)."
+  (let* ((rlist (reverse alist))
+         (vars (mapcar #'car rlist))
+         (vals (mapcar #'cdr rlist)))
+    (progv vars vals
+      (funcall fun))))
+
+(defmacro with-bindings (alist &body body)
+  "See `call-with-bindings'."
+  `(call-with-bindings ,alist (lambda () , at body)))
+
+;;; The `DEFSLIMEFUN' macro defines a function that Emacs can call via
+;;; RPC.
+
+(defmacro defslimefun (name arglist &body rest)
+  "A DEFUN for functions that Emacs can call by RPC."
+  `(progn
+     (defun ,name ,arglist , at rest)
+     ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
+     (eval-when (:compile-toplevel :load-toplevel :execute)
+       (export ',name :swank))))
+
+(defun missing-arg ()
+  "A function that the compiler knows will never to return a value.
+You can use (MISSING-ARG) as the initform for defstruct slots that
+must always be supplied. This way the :TYPE slot option need not
+include some arbitrary initial value like NIL."
+  (error "A required &KEY or &OPTIONAL argument was not supplied."))
+
+
+;;;; Hooks
+;;;
+;;; We use Emacs-like `add-hook' and `run-hook' utilities to support
+;;; simple indirection. The interface is more CLish than the Emacs
+;;; Lisp one.
+
+(defmacro add-hook (place function)
+  "Add FUNCTION to the list of values on PLACE."
+  `(pushnew ,function ,place))
+
+(defun run-hook (functions &rest arguments)
+  "Call each of FUNCTIONS with ARGUMENTS."
+  (dolist (function functions)
+    (apply function arguments)))
+
+(defvar *new-connection-hook* '()
+  "This hook is run each time a connection is established.
+The connection structure is given as the argument.
+Backend code should treat the connection structure as opaque.")
+
+(defvar *connection-closed-hook* '()
+  "This hook is run when a connection is closed.
+The connection as passed as an argument.
+Backend code should treat the connection structure as opaque.")
+
+(defvar *pre-reply-hook* '()
+  "Hook run (without arguments) immediately before replying to an RPC.")
+
+(defvar *after-init-hook* '()
+  "Hook run after user init files are loaded.")
+
+(defun run-after-init-hook ()
+  (run-hook *after-init-hook*))
+
+
+;;;; Connections
+;;;
+;;; Connection structures represent the network connections between
+;;; Emacs and Lisp. Each has a socket stream, a set of user I/O
+;;; streams that redirect to Emacs, and optionally a second socket
+;;; used solely to pipe user-output to Emacs (an optimization).
+;;;
+
+(defstruct (connection
+             (:conc-name connection.)
+             (:print-function print-connection))
+  ;; Raw I/O stream of socket connection.
+  (socket-io        (missing-arg) :type stream :read-only t)
+  ;; Optional dedicated output socket (backending `user-output' slot).
+  ;; Has a slot so that it can be closed with the connection.
+  (dedicated-output nil :type (or stream null))
+  ;; Streams that can be used for user interaction, with requests
+  ;; redirected to Emacs.
+  (user-input       nil :type (or stream null))
+  (user-output      nil :type (or stream null))
+  (user-io          nil :type (or stream null))
+  ;; A stream that we use for *trace-output*; if nil, we user user-output.
+  (trace-output     nil :type (or stream null))
+  ;; A stream where we send REPL results.
+  (repl-results     nil :type (or stream null))
+  ;; In multithreaded systems we delegate certain tasks to specific
+  ;; threads. The `reader-thread' is responsible for reading network
+  ;; requests from Emacs and sending them to the `control-thread'; the
+  ;; `control-thread' is responsible for dispatching requests to the
+  ;; threads that should handle them; the `repl-thread' is the one
+  ;; that evaluates REPL expressions. The control thread dispatches
+  ;; all REPL evaluations to the REPL thread and for other requests it
+  ;; spawns new threads.
+  reader-thread
+  control-thread
+  repl-thread
+  ;; Callback functions:
+  ;; (SERVE-REQUESTS <this-connection>) serves all pending requests
+  ;; from Emacs.
+  (serve-requests   (missing-arg) :type function)
+  ;; (READ) is called to read and return one message from Emacs.
+  (read             (missing-arg) :type function)
+  ;; (SEND OBJECT) is called to send one message to Emacs.
+  (send             (missing-arg) :type function)
+  ;; (CLEANUP <this-connection>) is called when the connection is
+  ;; closed.
+  (cleanup          nil :type (or null function))
+  ;; Cache of macro-indentation information that has been sent to Emacs.
+  ;; This is used for preparing deltas to update Emacs's knowledge.
+  ;; Maps: symbol -> indentation-specification
+  (indentation-cache (make-hash-table :test 'eq) :type hash-table)
+  ;; The list of packages represented in the cache:
+  (indentation-cache-packages '())
+  ;; The communication style used.
+  (communication-style nil :type (member nil :spawn :sigio :fd-handler))
+  ;; The coding system for network streams.
+  (coding-system ))
+
+(defun print-connection (conn stream depth)
+  (declare (ignore depth))
+  (print-unreadable-object (conn stream :type t :identity t)))
+
+(defvar *connections* '()
+  "List of all active connections, with the most recent at the front.")
+
+(defvar *emacs-connection* nil
+  "The connection to Emacs currently in use.")
+
+(defvar *swank-state-stack* '()
+  "A list of symbols describing the current state.  Used for debugging
+and to detect situations where interrupts can be ignored.")
+
+(defun default-connection ()
+  "Return the 'default' Emacs connection.
+This connection can be used to talk with Emacs when no specific
+connection is in use, i.e. *EMACS-CONNECTION* is NIL.
+
+The default connection is defined (quite arbitrarily) as the most
+recently established one."
+  (first *connections*))
+
+(defslimefun state-stack ()
+  "Return the value of *SWANK-STATE-STACK*."
+  *swank-state-stack*)
+
+;; A conditions to include backtrace information
+(define-condition swank-error (error) 
+  ((condition :initarg :condition :reader swank-error.condition)
+   (backtrace :initarg :backtrace :reader swank-error.backtrace))
+  (:report (lambda (condition stream)
+             (princ (swank-error.condition condition) stream))))
+
+(defun make-swank-error (condition)
+  (let ((bt (ignore-errors 
+              (call-with-debugging-environment 
+               (lambda () (backtrace 0 nil))))))
+    (make-condition 'swank-error :condition condition :backtrace bt)))
+
+(add-hook *new-connection-hook* 'notify-backend-of-connection)
+(defun notify-backend-of-connection (connection)
+  (declare (ignore connection))
+  (emacs-connected))
+
+
+;;;; Utilities
+
+;;;;; Helper macros
+
+(defmacro with-io-redirection ((connection) &body body)
+  "Execute BODY I/O redirection to CONNECTION.
+If *REDIRECT-IO* is true then all standard I/O streams are redirected."
+  `(maybe-call-with-io-redirection ,connection (lambda () , at body)))
+
+(defun maybe-call-with-io-redirection (connection fun)
+  (if *redirect-io*
+      (call-with-redirected-io connection fun)
+      (funcall fun)))
+      
+(defmacro with-connection ((connection) &body body)
+  "Execute BODY in the context of CONNECTION."
+  `(call-with-connection ,connection (lambda () , at body)))
+
+(defun call-with-connection (connection fun)
+  (let ((*emacs-connection* connection))
+    (with-io-redirection (*emacs-connection*)
+      (call-with-debugger-hook #'swank-debugger-hook fun))))
+
+(defmacro without-interrupts (&body body)
+  `(call-without-interrupts (lambda () , at body)))
+
+(defmacro destructure-case (value &rest patterns)
+  "Dispatch VALUE to one of PATTERNS.
+A cross between `case' and `destructuring-bind'.
+The pattern syntax is:
+  ((HEAD . ARGS) . BODY)
+The list of patterns is searched for a HEAD `eq' to the car of
+VALUE. If one is found, the BODY is executed with ARGS bound to the
+corresponding values in the CDR of VALUE."
+  (let ((operator (gensym "op-"))
+	(operands (gensym "rand-"))
+	(tmp (gensym "tmp-")))
+    `(let* ((,tmp ,value)
+	    (,operator (car ,tmp))
+	    (,operands (cdr ,tmp)))
+       (case ,operator
+         ,@(loop for (pattern . body) in patterns collect 
+                   (if (eq pattern t)
+                       `(t , at body)
+                       (destructuring-bind (op &rest rands) pattern
+                         `(,op (destructuring-bind ,rands ,operands 
+                                 , at body)))))
+         ,@(if (eq (caar (last patterns)) t)
+               '()
+               `((t (error "destructure-case failed: ~S" ,tmp))))))))
+
+(defmacro with-temp-package (var &body body)
+  "Execute BODY with VAR bound to a temporary package.
+The package is deleted before returning."
+  `(let ((,var (make-package (gensym "TEMP-PACKAGE-"))))
+     (unwind-protect (progn , at body)
+       (delete-package ,var))))
+
+(defmacro do-symbols* ((var &optional (package '*package*) result-form) &body body)
+  "Just like do-symbols, but makes sure a symbol is visited only once."
+  (let ((seen-ht (gensym "SEEN-HT")))
+    `(let ((,seen-ht (make-hash-table :test #'eq)))
+      (do-symbols (,var ,package ,result-form)
+        (unless (gethash ,var ,seen-ht)
+          (setf (gethash ,var ,seen-ht) t)
+          , at body)))))
+
+
+;;;;; Logging
+
+(defvar *log-events* nil)
+(defvar *log-output* *error-output*)
+(defvar *event-history* (make-array 40 :initial-element nil)
+  "A ring buffer to record events for better error messages.")
+(defvar *event-history-index* 0)
+(defvar *enable-event-history* t)
+
+(defun log-event (format-string &rest args)
+  "Write a message to *terminal-io* when *log-events* is non-nil.
+Useful for low level debugging."
+  (with-standard-io-syntax
+    (let ((*print-readably* nil)
+          (*print-pretty* nil)
+          (*package* *swank-io-package*))
+      (when *enable-event-history*
+        (setf (aref *event-history* *event-history-index*) 
+              (format nil "~?" format-string args))
+        (setf *event-history-index* 
+              (mod (1+ *event-history-index*) (length *event-history*))))
+      (when *log-events*
+        (apply #'format *log-output* format-string args)
+        (force-output *log-output*)))))
+
+(defun event-history-to-list ()
+  "Return the list of events (older events first)."
+  (let ((arr *event-history*)
+        (idx *event-history-index*))
+    (concatenate 'list (subseq arr idx) (subseq arr 0 idx))))
+
+(defun dump-event-history (stream)
+  (dolist (e (event-history-to-list))
+    (dump-event e stream)))
+
+(defun dump-event (event stream)
+  (cond ((stringp event)
+         (write-string (escape-non-ascii event) stream))
+        ((null event))
+        (t (format stream "Unexpected event: ~A~%" event))))
+
+(defun escape-non-ascii (string)
+  "Return a string like STRING but with non-ascii chars escaped."
+  (cond ((ascii-string-p string) string)
+        (t (with-output-to-string (out)
+             (loop for c across string do
+               (cond ((ascii-char-p c) (write-char c out))
+                     (t (format out "\\x~4,'0X" (char-code c)))))))))
+
+(defun ascii-string-p (o)
+  (and (stringp o)
+       (every #'ascii-char-p o)))
+
+(defun ascii-char-p (c) 
+  (<= (char-code c) 127))
+
+
+;;;;; Misc
+
+(defun length= (seq n)
+  "Test for whether SEQ contains N number of elements. I.e. it's equivalent
+ to (= (LENGTH SEQ) N), but besides being more concise, it may also be more
+ efficiently implemented."
+  (etypecase seq 
+    (list (do ((i n (1- i))
+               (list seq (cdr list)))
+              ((or (<= i 0) (null list))
+               (and (zerop i) (null list)))))
+    (sequence (= (length seq) n))))
+
+(defun ensure-list (thing)
+  (if (listp thing) thing (list thing)))
+
+(defun recursively-empty-p (list)
+  "Returns whether LIST consists only of arbitrarily nested empty lists."
+  (cond ((not (listp list)) nil)
+	((null list) t)
+	(t (every #'recursively-empty-p list))))
+
+(defun maybecall (bool fn &rest args)
+  "Call FN with ARGS if BOOL is T. Otherwise return ARGS as multiple values."
+  (if bool (apply fn args) (values-list args)))
+
+(defun exactly-one-p (&rest values)
+  "If exactly one value in VALUES is non-NIL, this value is returned.
+Otherwise NIL is returned."
+  (let ((found nil))
+    (dolist (v values)
+      (when v (if found
+                  (return-from exactly-one-p nil)
+                  (setq found v))))
+    found))
+
+
+;;;;; Symbols
+
+(defun symbol-status (symbol &optional (package (symbol-package symbol)))
+  "Returns one of 
+
+  :INTERNAL  if the symbol is _present_ in PACKAGE as an _internal_ symbol,
+
+  :EXTERNAL  if the symbol is _present_ in PACKAGE as an _external_ symbol,
+
+  :INHERITED if the symbol is _inherited_ by PACKAGE through USE-PACKAGE,
+             but is not _present_ in PACKAGE,
+
+  or NIL     if SYMBOL is not _accessible_ in PACKAGE.
+
+
+Be aware not to get confused with :INTERNAL and how \"internal
+symbols\" are defined in the spec; there is a slight mismatch of
+definition with the Spec and what's commonly meant when talking
+about internal symbols most times. As the spec says:
+
+  In a package P, a symbol S is
+  
+     _accessible_  if S is either _present_ in P itself or was
+                   inherited from another package Q (which implies
+                   that S is _external_ in Q.)
+  
+        You can check that with: (AND (SYMBOL-STATUS S P) T)
+  
+  
+     _present_     if either P is the /home package/ of S or S has been
+                   imported into P or exported from P by IMPORT, or
+                   EXPORT respectively.
+  
+                   Or more simply, if S is not _inherited_.
+  
+        You can check that with: (LET ((STATUS (SYMBOL-STATUS S P)))
+                                   (AND STATUS 
+                                        (NOT (EQ STATUS :INHERITED))))
+  
+  
+     _external_    if S is going to be inherited into any package that
+                   /uses/ P by means of USE-PACKAGE, MAKE-PACKAGE, or
+                   DEFPACKAGE.
+  
+                   Note that _external_ implies _present_, since to
+                   make a symbol _external_, you'd have to use EXPORT
+                   which will automatically make the symbol _present_.
+  
+        You can check that with: (EQ (SYMBOL-STATUS S P) :EXTERNAL)
+  
+  
+     _internal_    if S is _accessible_ but not _external_.
+
+        You can check that with: (LET ((STATUS (SYMBOL-STATUS S P)))
+                                   (AND STATUS 
+                                        (NOT (EQ STATUS :EXTERNAL))))
+  
+
+        Notice that this is *different* to
+                                 (EQ (SYMBOL-STATUS S P) :INTERNAL)
+        because what the spec considers _internal_ is split up into two
+        explicit pieces: :INTERNAL, and :INHERITED; just as, for instance,
+        CL:FIND-SYMBOL does. 
+
+        The rationale is that most times when you speak about \"internal\"
+        symbols, you're actually not including the symbols inherited 
+        from other packages, but only about the symbols directly specific
+        to the package in question.
+"
+  (when package     ; may be NIL when symbol is completely uninterned.
+    (check-type symbol symbol) (check-type package package)
+    (multiple-value-bind (present-symbol status)
+        (find-symbol (symbol-name symbol) package)
+      (and (eq symbol present-symbol) status))))
+
+(defun symbol-external-p (symbol &optional (package (symbol-package symbol)))
+  "True if SYMBOL is external in PACKAGE.
+If PACKAGE is not specified, the home package of SYMBOL is used."
+  (eq (symbol-status symbol package) :external))
+
+
+(defun classify-symbol (symbol)
+  "Returns a list of classifiers that classify SYMBOL according
+to its underneath objects (e.g. :BOUNDP if SYMBOL constitutes a
+special variable.) The list may contain the following classification
+keywords: :BOUNDP, :FBOUNDP, :GENERIC-FUNCTION, :CLASS, :MACRO, 
+:SPECIAL-OPERATOR, and/or :PACKAGE"
+  (check-type symbol symbol)
+  (let (result)
+    (when (boundp symbol)             (push :boundp result))
+    (when (fboundp symbol)            (push :fboundp result))
+    (when (find-class symbol nil)     (push :class result))
+    (when (macro-function symbol)     (push :macro result))
+    (when (special-operator-p symbol) (push :special-operator result))
+    (when (find-package symbol)       (push :package result))
+    (when (typep (ignore-errors (fdefinition symbol))
+                 'generic-function)
+      (push :generic-function result))
+    result))
+
+(defun symbol-classification->string (flags)
+  (format nil "~A~A~A~A~A~A~A"
+          (if (member :boundp flags) "b" "-")
+          (if (member :fboundp flags) "f" "-")
+          (if (member :generic-function flags) "g" "-")
+          (if (member :class flags) "c" "-")
+          (if (member :macro flags) "m" "-")
+          (if (member :special-operator flags) "s" "-")
+          (if (member :package flags) "p" "-")))
+
+
+;;;; TCP Server
+
+(defvar *use-dedicated-output-stream* nil
+  "When T swank will attempt to create a second connection to
+  Emacs which is used just to send output.")
+
+(defvar *dedicated-output-stream-port* 0
+  "Which port we should use for the dedicated output stream.")
+
+(defvar *communication-style* (preferred-communication-style))
+
+(defvar *dont-close* nil
+  "Default value of :dont-close argument to start-server and
+  create-server.")
+
+(defvar *dedicated-output-stream-buffering* 
+  (if (eq *communication-style* :spawn) :full :none)
+  "The buffering scheme that should be used for the output stream.
+Valid values are :none, :line, and :full.")
+
+(defvar *coding-system* "iso-latin-1-unix")
+
+(defun start-server (port-file &key (style *communication-style*)
+                                    (dont-close *dont-close*)
+                                    (coding-system *coding-system*))
+  "Start the server and write the listen port number to PORT-FILE.
+This is the entry point for Emacs."
+  (flet ((start-server-aux ()
+           (setup-server 0 (lambda (port) 
+                             (announce-server-port port-file port))
+                         style dont-close 
+                         (find-external-format-or-lose coding-system))))
+    (if (eq style :spawn)
+        (initialize-multiprocessing #'start-server-aux)
+        (start-server-aux))))
+
+(defun create-server (&key (port default-server-port)
+                      (style *communication-style*)
+                      (dont-close *dont-close*) 
+                      (coding-system *coding-system*))
+  "Start a SWANK server on PORT running in STYLE.
+If DONT-CLOSE is true then the listen socket will accept multiple
+connections, otherwise it will be closed after the first."
+  (setup-server port #'simple-announce-function style dont-close 
+                (find-external-format-or-lose coding-system)))
+
+(defun find-external-format-or-lose (coding-system)
+  (or (find-external-format coding-system)
+      (error "Unsupported coding system: ~s" coding-system)))
+
+(defparameter *loopback-interface* "127.0.0.1")
+
+(defun setup-server (port announce-fn style dont-close external-format)
+  (declare (type function announce-fn))
+  (let* ((socket (create-socket *loopback-interface* port))
+         (port (local-port socket)))
+    (funcall announce-fn port)
+    (flet ((serve ()
+             (serve-connection socket style dont-close external-format)))
+      (ecase style
+        (:spawn
+         (spawn (lambda () (loop do (ignore-errors (serve)) while dont-close))
+                :name "Swank"))
+        ((:fd-handler :sigio)
+         (add-fd-handler socket (lambda () (serve))))
+        ((nil) (loop do (serve) while dont-close)))
+      port)))
+
+(defun serve-connection (socket style dont-close external-format)
+  (let ((closed-socket-p nil))
+    (unwind-protect
+         (let ((client (accept-authenticated-connection
+                        socket :external-format external-format)))
+           (unless dont-close
+             (close-socket socket)
+             (setf closed-socket-p t))
+           (let ((connection (create-connection client style)))
+             (run-hook *new-connection-hook* connection)
+             (push connection *connections*)
+             (serve-requests connection)))
+      (unless (or dont-close closed-socket-p)
+        (close-socket socket)))))
+
+(defun accept-authenticated-connection (&rest args)
+  (let ((new (apply #'accept-connection args))
+        (success nil))
+    (unwind-protect
+         (let ((secret (slime-secret)))
+           (when secret
+             (set-stream-timeout new 20)
+             (let ((first-val (decode-message new)))
+               (unless (and (stringp first-val) (string= first-val secret))
+                 (error "Incoming connection doesn't know the password."))))
+           (set-stream-timeout new nil)
+           (setf success t))
+      (unless success
+        (close new :abort t)))
+    new))
+
+(defun slime-secret ()
+  "Finds the magic secret from the user's home directory.  Returns nil
+if the file doesn't exist; otherwise the first line of the file."
+  (with-open-file (in
+                   (merge-pathnames (user-homedir-pathname) #p".slime-secret")
+                   :if-does-not-exist nil)
+    (and in (read-line in nil ""))))
+
+(defun serve-requests (connection)
+  "Read and process all requests on connections."
+  (funcall (connection.serve-requests connection) connection))
+
+(defun announce-server-port (file port)
+  (with-open-file (s file
+                     :direction :output
+                     :if-exists :error
+                     :if-does-not-exist :create)
+    (format s "~S~%" port))
+  (simple-announce-function port))
+
+(defun simple-announce-function (port)
+  (when *swank-debug-p*
+    (format *log-output* "~&;; Swank started at port: ~D.~%" port)
+    (force-output *log-output*)))
+
+(defun open-streams (connection)
+  "Return the 5 streams for IO redirection:
+DEDICATED-OUTPUT INPUT OUTPUT IO REPL-RESULTS"
+  (multiple-value-bind (output-fn dedicated-output) 
+      (make-output-function connection)
+    (let ((input-fn
+           (lambda () 
+             (with-connection (connection)
+               (with-simple-restart (abort-read
+                                     "Abort reading input from Emacs.")
+                 (read-user-input-from-emacs))))))
+      (multiple-value-bind (in out) (make-fn-streams input-fn output-fn)
+        (let ((out (or dedicated-output out)))
+          (let ((io (make-two-way-stream in out)))
+            (mapc #'make-stream-interactive (list in out io))
+            (let ((repl-results
+                   (make-output-stream-for-target connection :repl-result)))
+              (values dedicated-output in out io repl-results))))))))
+
+(defun make-output-function (connection)
+  "Create function to send user output to Emacs.
+This function may open a dedicated socket to send output. It
+returns two values: the output function, and the dedicated
+stream (or NIL if none was created)."
+  (if *use-dedicated-output-stream*
+      (let ((stream (open-dedicated-output-stream 
+                     (connection.socket-io connection))))
+        (values (lambda (string)
+                  (write-string string stream)
+                  (force-output stream))
+                stream))
+      (values (lambda (string) 
+                (with-connection (connection)
+                  (with-simple-restart
+                      (abort "Abort sending output to Emacs.")
+                    (send-to-emacs `(:write-string ,string)))))
+              nil)))
+
+(defun make-output-function-for-target (connection target)
+  "Create a function to send user output to a specific TARGET in Emacs."
+  (lambda (string) 
+    (with-connection (connection)
+      (with-simple-restart
+          (abort "Abort sending output to Emacs.")
+        (send-to-emacs `(:write-string ,string ,target))))))
+
+(defun make-output-stream-for-target (connection target)
+  "Create a stream that sends output to a specific TARGET in Emacs."
+  (nth-value 1 (make-fn-streams 
+                (lambda ()
+                  (error "Should never be called"))
+                (make-output-function-for-target connection target))))
+
+(defun open-dedicated-output-stream (socket-io)
+  "Open a dedicated output connection to the Emacs on SOCKET-IO.
+Return an output stream suitable for writing program output.
+
+This is an optimized way for Lisp to deliver output to Emacs."
+  (let ((socket (create-socket *loopback-interface* 
+                               *dedicated-output-stream-port*)))
+    (unwind-protect
+         (let ((port (local-port socket)))
+           (encode-message `(:open-dedicated-output-stream ,port) socket-io)
+           (let ((dedicated (accept-authenticated-connection 
+                             socket 
+                             :external-format 
+                             (or (ignore-errors
+                                   (stream-external-format socket-io))
+                                 :default)
+                             :buffering *dedicated-output-stream-buffering*
+                             :timeout 30)))
+             (close-socket socket)
+             (setf socket nil)
+             dedicated))
+      (when socket
+        (close-socket socket)))))
+
+(defvar *sldb-quit-restart* 'abort
+  "What restart should swank attempt to invoke when the user sldb-quits.")
+
+(defun handle-request (connection)
+  "Read and process one request.  The processing is done in the extent
+of the toplevel restart."
+  (assert (null *swank-state-stack*))
+  (let ((*swank-state-stack* '(:handle-request)))
+    (with-connection (connection)
+      (with-simple-restart (abort "Return to SLIME's top level.")
+        (let ((*sldb-quit-restart* (find-restart 'abort)))
+          (read-from-emacs))))))
+
+(defun current-socket-io ()
+  (connection.socket-io *emacs-connection*))
+
+(defun close-connection (c &optional condition backtrace)
+  (format *log-output* "~&;; swank:close-connection: ~A~%" condition)
+  (let ((cleanup (connection.cleanup c)))
+    (when cleanup
+      (funcall cleanup c)))
+  (close (connection.socket-io c))
+  (when (connection.dedicated-output c)
+    (close (connection.dedicated-output c)))
+  (setf *connections* (remove c *connections*))
+  (run-hook *connection-closed-hook* c)
+  (when (and condition (not (typep condition 'end-of-file)))
+    (finish-output *log-output*)
+    (format *log-output* "~&;; Event history start:~%")
+    (dump-event-history *log-output*)
+    (format *log-output* ";; Event history end.~%~
+                        ;; Backtrace:~%~{~A~%~}~
+                        ;; Connection to Emacs lost. [~%~
+                        ;;  condition: ~A~%~
+                        ;;  type: ~S~%~
+                        ;;  encoding: ~A style: ~S dedicated: ~S]~%"
+            backtrace
+            (escape-non-ascii (safe-condition-message condition) )
+            (type-of condition)
+            (ignore-errors (stream-external-format (connection.socket-io c)))
+            (connection.communication-style c)
+            *use-dedicated-output-stream*)
+    (finish-output *log-output*)))
+
+(defvar *debug-on-swank-error* nil
+  "When non-nil internal swank errors will drop to a
+  debugger (not an sldb buffer). Do not set this to T unless you
+  want to debug swank internals.")
+
+(defmacro with-reader-error-handler ((connection) &body body)
+  (let ((con (gensym))
+        (blck (gensym)))
+    `(let ((,con ,connection))
+       (block ,blck
+         (handler-bind ((swank-error
+                         (lambda (e)
+                           (if *debug-on-swank-error*
+                               (invoke-debugger e)
+                               (return-from ,blck
+                                 (close-connection 
+                                  ,con 
+                                  (swank-error.condition e)
+                                  (swank-error.backtrace e)))))))
+           (progn , at body))))))
+
+(defslimefun simple-break ()
+  (with-simple-restart  (continue "Continue from interrupt.")
+    (call-with-debugger-hook
+     #'swank-debugger-hook
+     (lambda ()
+       (invoke-debugger 
+        (make-condition 'simple-error 
+                        :format-control "Interrupt from Emacs")))))
+  nil)
+
+;;;;;; Thread based communication
+
+(defvar *active-threads* '())
+
+(defun read-loop (control-thread input-stream connection)
+  (with-reader-error-handler (connection)
+    (loop (send control-thread (decode-message input-stream)))))
+
+(defun dispatch-loop (socket-io connection)
+  (let ((*emacs-connection* connection))
+    (handler-bind ((error (lambda (e)
+                            (if *debug-on-swank-error*
+                                (invoke-debugger e)
+                                (return-from dispatch-loop
+                                  (close-connection connection e))))))
+      (loop (dispatch-event (receive) socket-io)))))
+
+(defun repl-thread (connection)
+  (let ((thread (connection.repl-thread connection)))
+    (when (not thread)
+      (log-event "ERROR: repl-thread is nil"))
+    (assert thread)
+    (cond ((thread-alive-p thread)
+           thread)
+          (t
+           (setf (connection.repl-thread connection)
+                 (spawn-repl-thread connection "new-repl-thread"))))))
+
+(defun find-worker-thread (id)
+  (etypecase id
+    ((member t)
+     (car *active-threads*))
+    ((member :repl-thread) 
+     (repl-thread *emacs-connection*))
+    (fixnum 
+     (find-thread id))))
+
+(defun interrupt-worker-thread (id)
+  (let ((thread (or (find-worker-thread id)
+                    (repl-thread *emacs-connection*))))
+    (interrupt-thread thread #'simple-break)))
+
+(defun thread-for-evaluation (id)
+  "Find or create a thread to evaluate the next request."
+  (let ((c *emacs-connection*))
+    (etypecase id
+      ((member t)
+       (spawn-worker-thread c))
+      ((member :repl-thread)
+       (repl-thread c))
+      (fixnum
+       (find-thread id)))))
+
+(defun spawn-worker-thread (connection)
+  (spawn (lambda () 
+           (with-bindings *default-worker-thread-bindings*
+             (handle-request connection)))
+         :name "worker"))
+
+(defun spawn-repl-thread (connection name)
+  (spawn (lambda () 
+           (with-bindings *default-worker-thread-bindings*
+             (repl-loop connection)))
+         :name name))
+
+(defun dispatch-event (event socket-io)
+  "Handle an event triggered either by Emacs or within Lisp."
+  (log-event "DISPATCHING: ~S~%" event)
+  (destructure-case event
+    ((:emacs-rex form package thread-id id)
+     (let ((thread (thread-for-evaluation thread-id)))
+       (push thread *active-threads*)
+       (send thread `(eval-for-emacs ,form ,package ,id))))
+    ((:return thread &rest args)
+     (let ((tail (member thread *active-threads*)))
+       (setq *active-threads* (nconc (ldiff *active-threads* tail)
+                                     (cdr tail))))
+     (encode-message `(:return , at args) socket-io))
+    ((:emacs-interrupt thread-id)
+     (interrupt-worker-thread thread-id))
+    (((:debug :debug-condition :debug-activate :debug-return)
+      thread &rest args)
+     (encode-message `(,(car event) ,(thread-id thread) , at args) socket-io))
+    ((:read-string thread &rest args)
+     (encode-message `(:read-string ,(thread-id thread) , at args) socket-io))
+    ((:y-or-n-p thread &rest args)
+     (encode-message `(:y-or-n-p ,(thread-id thread) , at args) socket-io))
+    ((:read-aborted thread &rest args)
+     (encode-message `(:read-aborted ,(thread-id thread) , at args) socket-io))
+    ((:emacs-return-string thread-id tag string)
+     (send (find-thread thread-id) `(take-input ,tag ,string)))
+    ((:eval thread &rest args)
+     (encode-message `(:eval ,(thread-id thread) , at args) socket-io))
+    ((:emacs-return thread-id tag value)
+     (send (find-thread thread-id) `(take-input ,tag ,value)))
+    (((:write-string :presentation-start :presentation-end
+                     :new-package :new-features :ed :%apply :indentation-update
+                     :eval-no-wait :background-message :inspect)
+      &rest _)
+     (declare (ignore _))
+     (encode-message event socket-io))))
+
+(defun spawn-threads-for-connection (connection)
+  (macrolet ((without-debugger-hook (&body body) 
+               `(call-with-debugger-hook nil (lambda () , at body))))
+    (let* ((socket-io (connection.socket-io connection))
+           (control-thread (spawn (lambda ()
+                                    (without-debugger-hook
+                                     (dispatch-loop socket-io connection)))
+                                  :name "control-thread")))
+      (setf (connection.control-thread connection) control-thread)
+      (let ((reader-thread (spawn (lambda () 
+                                    (let ((go (receive)))
+                                      (assert (eq go 'accept-input)))
+                                    (without-debugger-hook
+                                     (read-loop control-thread socket-io
+                                                connection)))
+                                  :name "reader-thread"))
+            (repl-thread (spawn-repl-thread connection "repl-thread")))
+        (setf (connection.repl-thread connection) repl-thread)
+        (setf (connection.reader-thread connection) reader-thread)
+        (send reader-thread 'accept-input)
+        connection))))
+
+(defun cleanup-connection-threads (connection)
+  (let ((threads (list (connection.repl-thread connection)
+                       (connection.reader-thread connection)
+                       (connection.control-thread connection))))
+    (dolist (thread threads)
+      (when (and thread 
+                 (thread-alive-p thread)
+                 (not (equal (current-thread) thread)))
+        (kill-thread thread)))))
+
+(defun repl-loop (connection)
+  (loop (handle-request connection)))
+
+(defun process-available-input (stream fn)
+  (loop while (input-available-p stream)
+        do (funcall fn)))
+
+(defun input-available-p (stream)
+  ;; return true iff we can read from STREAM without waiting or if we
+  ;; hit EOF
+  (let ((c (read-char-no-hang stream nil :eof)))
+    (cond ((not c) nil)
+          ((eq c :eof) t)
+          (t 
+           (unread-char c stream)
+           t))))
+
+;;;;;; Signal driven IO
+
+(defun install-sigio-handler (connection)
+  (let ((client (connection.socket-io connection)))
+    (flet ((handler ()
+	     (cond ((null *swank-state-stack*)
+		    (with-reader-error-handler (connection)
+		      (process-available-input 
+		       client (lambda () (handle-request connection)))))
+		   ((eq (car *swank-state-stack*) :read-next-form))
+		   (t (process-available-input client #'read-from-emacs)))))
+      (add-sigio-handler client #'handler)
+      (handler))))
+
+(defun deinstall-sigio-handler (connection)
+  (remove-sigio-handlers (connection.socket-io connection)))
+
+;;;;;; SERVE-EVENT based IO
+
+(defun install-fd-handler (connection)
+  (let ((client (connection.socket-io connection)))
+    (flet ((handler ()   
+	     (cond ((null *swank-state-stack*)
+		    (with-reader-error-handler (connection)
+		      (process-available-input 
+		       client (lambda () (handle-request connection)))))
+		   ((eq (car *swank-state-stack*) :read-next-form))
+		   (t 
+		    (process-available-input client #'read-from-emacs)))))
+      ;;;; handle sigint
+      ;;(install-debugger-globally
+      ;; (lambda (c h)
+      ;;   (with-reader-error-handler (connection)
+      ;;     (block debugger
+      ;;       (with-connection (connection)
+      ;;	 (swank-debugger-hook c h)
+      ;;	 (return-from debugger))
+      ;;       (abort)))))
+      (add-fd-handler client #'handler)
+      (handler))))
+
+(defun deinstall-fd-handler (connection)
+  (remove-fd-handlers (connection.socket-io connection)))
+
+;;;;;; Simple sequential IO
+
+(defun simple-serve-requests (connection)
+  (unwind-protect 
+       (with-simple-restart (close-connection "Close SLIME connection")
+         (with-reader-error-handler (connection)
+           (loop
+            (handle-request connection))))
+    (close-connection connection)))
+
+(defun read-from-socket-io ()
+  (let ((event (decode-message (current-socket-io))))
+    (log-event "DISPATCHING: ~S~%" event)
+    (destructure-case event
+      ((:emacs-rex form package thread id)
+       (declare (ignore thread))
+       `(eval-for-emacs ,form ,package ,id))
+      ((:emacs-interrupt thread)
+       (declare (ignore thread))
+       '(simple-break))
+      ((:emacs-return-string thread tag string)
+       (declare (ignore thread))
+       `(take-input ,tag ,string))
+      ((:emacs-return thread tag value)
+       (declare (ignore thread))
+       `(take-input ,tag ,value)))))
+
+(defun send-to-socket-io (event) 
+  (log-event "DISPATCHING: ~S~%" event)
+  (flet ((send (o) 
+           (without-interrupts 
+             (encode-message o (current-socket-io)))))
+    (destructure-case event
+      (((:debug-activate :debug :debug-return :read-string :read-aborted 
+                         :y-or-n-p :eval)
+        thread &rest args)
+       (declare (ignore thread))
+       (send `(,(car event) 0 , at args)))
+      ((:return thread &rest args)
+       (declare (ignore thread))
+       (send `(:return , at args)))
+      (((:write-string :new-package :new-features :debug-condition
+                       :presentation-start :presentation-end
+                       :indentation-update :ed :%apply :eval-no-wait
+                       :background-message :inspect)
+        &rest _)
+       (declare (ignore _))
+       (send event)))))
+
+(defun initialize-streams-for-connection (connection)
+  (multiple-value-bind (dedicated in out io repl-results) 
+      (open-streams connection)
+    (setf (connection.dedicated-output connection) dedicated
+          (connection.user-io connection)          io
+          (connection.user-output connection)      out
+          (connection.user-input connection)       in
+          (connection.repl-results connection)     repl-results)
+    connection))
+
+(defun create-connection (socket-io style)
+  (let ((success nil))
+    (unwind-protect
+         (let ((c (ecase style
+                    (:spawn
+                     (make-connection :socket-io socket-io
+                                      :read #'read-from-control-thread
+                                      :send #'send-to-control-thread
+                                      :serve-requests #'spawn-threads-for-connection
+                                      :cleanup #'cleanup-connection-threads))
+                    (:sigio
+                     (make-connection :socket-io socket-io
+                                      :read #'read-from-socket-io
+                                      :send #'send-to-socket-io
+                                      :serve-requests #'install-sigio-handler
+                                      :cleanup #'deinstall-sigio-handler))
+                    (:fd-handler
+                     (make-connection :socket-io socket-io
+                                      :read #'read-from-socket-io
+                                      :send #'send-to-socket-io
+                                      :serve-requests #'install-fd-handler
+                                      :cleanup #'deinstall-fd-handler))
+                    ((nil)
+                     (make-connection :socket-io socket-io
+                                      :read #'read-from-socket-io
+                                      :send #'send-to-socket-io
+                                      :serve-requests #'simple-serve-requests)))))
+           (setf (connection.communication-style c) style)
+           (initialize-streams-for-connection c)
+           (setf success t)
+           c)
+      (unless success
+        (close socket-io :abort t)))))
+
+
+;;;; IO to Emacs
+;;;
+;;; This code handles redirection of the standard I/O streams
+;;; (`*standard-output*', etc) into Emacs. The `connection' structure
+;;; contains the appropriate streams, so all we have to do is make the
+;;; right bindings.
+
+;;;;; Global I/O redirection framework
+;;;
+;;; Optionally, the top-level global bindings of the standard streams
+;;; can be assigned to be redirected to Emacs. When Emacs connects we
+;;; redirect the streams into the connection, and they keep going into
+;;; that connection even if more are established. If the connection
+;;; handling the streams closes then another is chosen, or if there
+;;; are no connections then we revert to the original (real) streams.
+;;;
+;;; It is slightly tricky to assign the global values of standard
+;;; streams because they are often shadowed by dynamic bindings. We
+;;; solve this problem by introducing an extra indirection via synonym
+;;; streams, so that *STANDARD-INPUT* is a synonym stream to
+;;; *CURRENT-STANDARD-INPUT*, etc. We never shadow the "current"
+;;; variables, so they can always be assigned to affect a global
+;;; change.
+
+(defvar *globally-redirect-io* nil
+  "When non-nil globally redirect all standard streams to Emacs.")
+
+;;;;; Global redirection setup
+
+(defvar *saved-global-streams* '()
+  "A plist to save and restore redirected stream objects.
+E.g. the value for '*standard-output* holds the stream object
+for *standard-output* before we install our redirection.")
+
+(defun setup-stream-indirection (stream-var &optional stream)
+  "Setup redirection scaffolding for a global stream variable.
+Supposing (for example) STREAM-VAR is *STANDARD-INPUT*, this macro:
+
+1. Saves the value of *STANDARD-INPUT* in `*SAVED-GLOBAL-STREAMS*'.
+
+2. Creates *CURRENT-STANDARD-INPUT*, initially with the same value as
+*STANDARD-INPUT*.
+
+3. Assigns *STANDARD-INPUT* to a synonym stream pointing to
+*CURRENT-STANDARD-INPUT*.
+
+This has the effect of making *CURRENT-STANDARD-INPUT* contain the
+effective global value for *STANDARD-INPUT*. This way we can assign
+the effective global value even when *STANDARD-INPUT* is shadowed by a
+dynamic binding."
+  (let ((current-stream-var (prefixed-var '#:current stream-var))
+        (stream (or stream (symbol-value stream-var))))
+    ;; Save the real stream value for the future.
+    (setf (getf *saved-global-streams* stream-var) stream)
+    ;; Define a new variable for the effective stream.
+    ;; This can be reassigned.
+    (proclaim `(special ,current-stream-var))
+    (set current-stream-var stream)
+    ;; Assign the real binding as a synonym for the current one.
+    (set stream-var (make-synonym-stream current-stream-var))))
+
+(defun prefixed-var (prefix variable-symbol)
+  "(PREFIXED-VAR \"FOO\" '*BAR*) => SWANK::*FOO-BAR*"
+  (let ((basename (subseq (symbol-name variable-symbol) 1)))
+    (intern (format nil "*~A-~A" (string prefix) basename) :swank)))
+
+(defvar *standard-output-streams*
+  '(*standard-output* *error-output* *trace-output*)
+  "The symbols naming standard output streams.")
+
+(defvar *standard-input-streams*
+  '(*standard-input*)
+  "The symbols naming standard input streams.")
+
+(defvar *standard-io-streams*
+  '(*debug-io* *query-io* *terminal-io*)
+  "The symbols naming standard io streams.")
+
+(defun init-global-stream-redirection ()
+  (when *globally-redirect-io*
+    (mapc #'setup-stream-indirection 
+          (append *standard-output-streams*
+                  *standard-input-streams*
+                  *standard-io-streams*))))
+
+(add-hook *after-init-hook* 'init-global-stream-redirection)
+
+(defun globally-redirect-io-to-connection (connection)
+  "Set the standard I/O streams to redirect to CONNECTION.
+Assigns *CURRENT-<STREAM>* for all standard streams."
+  (dolist (o *standard-output-streams*)
+    (set (prefixed-var '#:current o)
+         (connection.user-output connection)))
+  ;; FIXME: If we redirect standard input to Emacs then we get the
+  ;; regular Lisp top-level trying to read from our REPL.
+  ;;
+  ;; Perhaps the ideal would be for the real top-level to run in a
+  ;; thread with local bindings for all the standard streams. Failing
+  ;; that we probably would like to inhibit it from reading while
+  ;; Emacs is connected.
+  ;;
+  ;; Meanwhile we just leave *standard-input* alone.
+  #+NIL
+  (dolist (i *standard-input-streams*)
+    (set (prefixed-var '#:current i)
+         (connection.user-input connection)))
+  (dolist (io *standard-io-streams*)
+    (set (prefixed-var '#:current io)
+         (connection.user-io connection))))
+
+(defun revert-global-io-redirection ()
+  "Set *CURRENT-<STREAM>* to *REAL-<STREAM>* for all standard streams."
+  (dolist (stream-var (append *standard-output-streams*
+                              *standard-input-streams*
+                              *standard-io-streams*))
+    (set (prefixed-var '#:current stream-var)
+         (getf *saved-global-streams* stream-var))))
+
+;;;;; Global redirection hooks
+
+(defvar *global-stdio-connection* nil
+  "The connection to which standard I/O streams are globally redirected.
+NIL if streams are not globally redirected.")
+
+(defun maybe-redirect-global-io (connection)
+  "Consider globally redirecting to a newly-established CONNECTION."
+  (when (and *globally-redirect-io* (null *global-stdio-connection*))
+    (setq *global-stdio-connection* connection)
+    (globally-redirect-io-to-connection connection)))
+
+(defun update-redirection-after-close (closed-connection)
+  "Update redirection after a connection closes."
+  (check-type closed-connection connection)
+  (when (eq *global-stdio-connection* closed-connection)
+    (if (and (default-connection) *globally-redirect-io*)
+        ;; Redirect to another connection.
+        (globally-redirect-io-to-connection (default-connection))
+        ;; No more connections, revert to the real streams.
+        (progn (revert-global-io-redirection)
+               (setq *global-stdio-connection* nil)))))
+
+(add-hook *new-connection-hook*    'maybe-redirect-global-io)
+(add-hook *connection-closed-hook* 'update-redirection-after-close)
+
+;;;;; Redirection during requests
+;;;
+;;; We always redirect the standard streams to Emacs while evaluating
+;;; an RPC. This is done with simple dynamic bindings.
+
+(defun call-with-redirected-io (connection function)
+  "Call FUNCTION with I/O streams redirected via CONNECTION."
+  (declare (type function function))
+  (let* ((io  (connection.user-io connection))
+         (in  (connection.user-input connection))
+         (out (connection.user-output connection))
+         (trace (or (connection.trace-output connection) out))
+         (*standard-output* out)
+         (*error-output* out)
+         (*trace-output* trace)
+         (*debug-io* io)
+         (*query-io* io)
+         (*standard-input* in)
+         (*terminal-io* io))
+    (funcall function)))
+
+(defun read-from-emacs ()
+  "Read and process a request from Emacs."
+  (apply #'funcall (funcall (connection.read *emacs-connection*))))
+
+(defun read-from-control-thread ()
+  (receive))
+
+(defun decode-message (stream)
+  "Read an S-expression from STREAM using the SLIME protocol."
+  (let ((*swank-state-stack* (cons :read-next-form *swank-state-stack*)))
+    (handler-bind ((error (lambda (c) (error (make-swank-error c)))))
+      (let* ((length (decode-message-length stream))
+             (string (make-string length))
+             (pos (read-sequence string stream)))
+        (assert (= pos length) ()
+                "Short read: length=~D  pos=~D" length pos)
+        (log-event "READ: ~S~%" string)
+        (read-form string)))))
+
+(defun decode-message-length (stream)
+  (let ((buffer (make-string 6)))
+    (dotimes (i 6)
+      (setf (aref buffer i) (read-char stream)))
+    (parse-integer buffer :radix #x10)))
+
+(defun read-form (string)
+  (with-standard-io-syntax
+    (let ((*package* *swank-io-package*))
+      (read-from-string string))))
+
+(defvar *slime-features* nil
+  "The feature list that has been sent to Emacs.")
+
+(defun send-to-emacs (object)
+  "Send OBJECT to Emacs."
+  (funcall (connection.send *emacs-connection*) object))
+
+(defun send-oob-to-emacs (object)
+  (send-to-emacs object))
+
+(defun send-to-control-thread (object)
+  (send (connection.control-thread *emacs-connection*) object))
+
+(defun encode-message (message stream)
+  (let* ((string (prin1-to-string-for-emacs message))
+         (length (length string)))
+    (log-event "WRITE: ~A~%" string)
+    (let ((*print-pretty* nil))
+      (format stream "~6,'0x" length))
+    (write-string string stream)
+    ;;(terpri stream)
+    (finish-output stream)))
+
+(defun prin1-to-string-for-emacs (object)
+  (with-standard-io-syntax
+    (let ((*print-case* :downcase)
+          (*print-readably* nil)
+          (*print-pretty* nil)
+          (*package* *swank-io-package*))
+      (prin1-to-string object))))
+
+(defun force-user-output ()
+  (force-output (connection.user-io *emacs-connection*))
+  (finish-output (connection.user-output *emacs-connection*)))
+
+(defun clear-user-input  ()
+  (clear-input (connection.user-input *emacs-connection*)))
+
+(defvar *read-input-catch-tag* 0)
+
+(defun intern-catch-tag (tag)
+  ;; fixnums aren't eq in ABCL, so we use intern to create tags
+  (intern (format nil "~D" tag) :swank))
+
+(defun read-user-input-from-emacs ()
+  (let ((tag (incf *read-input-catch-tag*)))
+    (force-output)
+    (send-to-emacs `(:read-string ,(current-thread) ,tag))
+    (let ((ok nil))
+      (unwind-protect
+           (prog1 (catch (intern-catch-tag tag)
+                    (loop (read-from-emacs)))
+             (setq ok t))
+        (unless ok 
+          (send-to-emacs `(:read-aborted ,(current-thread) ,tag)))))))
+
+(defun y-or-n-p-in-emacs (format-string &rest arguments)
+  "Like y-or-n-p, but ask in the Emacs minibuffer."
+  (let ((tag (incf *read-input-catch-tag*))
+        (question (apply #'format nil format-string arguments)))
+    (force-output)
+    (send-to-emacs `(:y-or-n-p ,(current-thread) ,tag ,question))
+    (catch (intern-catch-tag tag)
+      (loop (read-from-emacs)))))
+
+(defslimefun take-input (tag input)
+  "Return the string INPUT to the continuation TAG."
+  (throw (intern-catch-tag tag) input))
+
+(defun process-form-for-emacs (form)
+  "Returns a string which emacs will read as equivalent to
+FORM. FORM can contain lists, strings, characters, symbols and
+numbers.
+
+Characters are converted emacs' ?<char> notaion, strings are left
+as they are (except for espacing any nested \" chars, numbers are
+printed in base 10 and symbols are printed as their symbol-name
+converted to lower case."
+  (etypecase form
+    (string (format nil "~S" form))
+    (cons (format nil "(~A . ~A)"
+                  (process-form-for-emacs (car form))
+                  (process-form-for-emacs (cdr form))))
+    (character (format nil "?~C" form))
+    (symbol (concatenate 'string (when (eq (symbol-package form)
+                                           #.(find-package "KEYWORD"))
+                                   ":")
+                         (string-downcase (symbol-name form))))
+    (number (let ((*print-base* 10))
+              (princ-to-string form)))))
+
+(defun eval-in-emacs (form &optional nowait)
+  "Eval FORM in Emacs."
+  (cond (nowait 
+         (send-to-emacs `(:eval-no-wait ,(process-form-for-emacs form))))
+        (t
+         (force-output)
+         (let* ((tag (incf *read-input-catch-tag*))
+                (value (catch (intern-catch-tag tag)
+                         (send-to-emacs 
+                          `(:eval ,(current-thread) ,tag 
+                            ,(process-form-for-emacs form)))
+                         (loop (read-from-emacs)))))
+           (destructure-case value
+             ((:ok value) value)
+             ((:abort) (abort)))))))
+
+(defvar *swank-wire-protocol-version* nil
+  "The version of the swank/slime communication protocol.")
+
+(defslimefun connection-info ()
+  "Return a key-value list of the form: 
+\(&key PID STYLE LISP-IMPLEMENTATION MACHINE FEATURES PACKAGE VERSION)
+PID: is the process-id of Lisp process (or nil, depending on the STYLE)
+STYLE: the communication style
+LISP-IMPLEMENTATION: a list (&key TYPE NAME VERSION)
+FEATURES: a list of keywords
+PACKAGE: a list (&key NAME PROMPT)
+VERSION: the protocol version"
+  (setq *slime-features* *features*)
+  `(:pid ,(getpid) :style ,(connection.communication-style *emacs-connection*)
+    :lisp-implementation (:type ,(lisp-implementation-type)
+                          :name ,(lisp-implementation-type-name)
+                          :version ,(lisp-implementation-version))
+    :machine (:instance ,(machine-instance)
+              :type ,(machine-type)
+              :version ,(machine-version))
+    :features ,(features-for-emacs)
+    :package (:name ,(package-name *package*)
+              :prompt ,(package-string-for-prompt *package*))
+    :version ,*swank-wire-protocol-version*))
+
+(defslimefun io-speed-test (&optional (n 5000) (m 1))
+  (let* ((s *standard-output*)
+         (*trace-output* (make-broadcast-stream s *log-output*)))
+    (time (progn
+            (dotimes (i n)
+              (format s "~D abcdefghijklm~%" i)
+              (when (zerop (mod n m))
+                (force-output s)))
+            (finish-output s)
+            (when *emacs-connection*
+              (eval-in-emacs '(message "done.")))))
+    (terpri *trace-output*)
+    (finish-output *trace-output*)
+    nil))
+
+
+;;;; Reading and printing
+
+(defmacro define-special (name doc)
+  "Define a special variable NAME with doc string DOC.
+This is like defvar, but NAME will not be initialized."
+  `(progn
+    (defvar ,name)
+    (setf (documentation ',name 'variable) ,doc)))
+
+(define-special *buffer-package*     
+    "Package corresponding to slime-buffer-package.  
+
+EVAL-FOR-EMACS binds *buffer-package*.  Strings originating from a slime
+buffer are best read in this package.  See also FROM-STRING and TO-STRING.")
+
+(define-special *buffer-readtable*
+    "Readtable associated with the current buffer")
+
+(defmacro with-buffer-syntax ((&rest _) &body body)
+  "Execute BODY with appropriate *package* and *readtable* bindings.
+
+This should be used for code that is conceptionally executed in an
+Emacs buffer."
+  (destructuring-bind () _
+    `(call-with-buffer-syntax (lambda () , at body))))
+
+(defun call-with-buffer-syntax (fun)
+  (let ((*package* *buffer-package*))
+    ;; Don't shadow *readtable* unnecessarily because that prevents
+    ;; the user from assigning to it.
+    (if (eq *readtable* *buffer-readtable*)
+        (call-with-syntax-hooks fun)
+        (let ((*readtable* *buffer-readtable*))
+          (call-with-syntax-hooks fun)))))
+
+(defun to-string (object)
+  "Write OBJECT in the *BUFFER-PACKAGE*.
+The result may not be readable. Handles problems with PRINT-OBJECT methods
+gracefully."
+  (with-buffer-syntax ()
+    (let ((*print-readably* nil))
+      (handler-case
+          (prin1-to-string object)
+        (error ()
+          (with-output-to-string (s)
+            (print-unreadable-object (object s :type t :identity t)
+              (princ "<<error printing object>>" s))))))))
+
+(defun from-string (string)
+  "Read string in the *BUFFER-PACKAGE*"
+  (with-buffer-syntax ()
+    (let ((*read-suppress* nil))
+      (read-from-string string))))
+
+;; FIXME: deal with #\| etc.  hard to do portably.
+(defun tokenize-symbol (string)
+  "STRING is interpreted as the string representation of a symbol
+and is tokenized accordingly. The result is returned in three
+values: The package identifier part, the actual symbol identifier
+part, and a flag if the STRING represents a symbol that is
+internal to the package identifier part. (Notice that the flag is
+also true with an empty package identifier part, as the STRING is
+considered to represent a symbol internal to some current package.)"
+  (let ((package (let ((pos (position #\: string)))
+                   (if pos (subseq string 0 pos) nil)))
+        (symbol (let ((pos (position #\: string :from-end t)))
+                  (if pos (subseq string (1+ pos)) string)))
+        (internp (not (= (count #\: string) 1))))
+    (values symbol package internp)))
+
+(defun tokenize-symbol-thoroughly (string)
+  "This version of TOKENIZE-SYMBOL handles escape characters."
+  (let ((package nil)
+        (token (make-array (length string) :element-type 'character
+                           :fill-pointer 0))
+        (backslash nil)
+        (vertical nil)
+        (internp nil))
+    (loop for char across string
+       do (cond
+            (backslash
+             (vector-push-extend char token)
+             (setq backslash nil))
+            ((char= char #\\) ; Quotes next character, even within |...|
+             (setq backslash t))
+            ((char= char #\|)
+             (setq vertical t))
+            (vertical
+             (vector-push-extend char token))
+            ((char= char #\:)
+             (if package
+                 (setq internp t)
+                 (setq package token
+                       token (make-array (length string)
+                                         :element-type 'character
+                                         :fill-pointer 0))))
+            (t
+             (vector-push-extend (casify-char char) token))))
+    (values token package (or (not package) internp))))
+
+(defun untokenize-symbol (package-name internal-p symbol-name)
+  "The inverse of TOKENIZE-SYMBOL.
+
+  (untokenize-symbol \"quux\" nil \"foo\") ==> \"quux:foo\"
+  (untokenize-symbol \"quux\" t \"foo\")   ==> \"quux::foo\"
+  (untokenize-symbol nil nil \"foo\")    ==> \"foo\"
+"
+  (cond ((not package-name) 	symbol-name)
+        (internal-p 		(cat package-name "::" symbol-name))
+        (t 			(cat package-name ":" symbol-name))))
+
+(defun casify-char (char)
+  "Convert CHAR accoring to readtable-case."
+  (ecase (readtable-case *readtable*)
+    (:preserve char)
+    (:upcase   (char-upcase char))
+    (:downcase (char-downcase char))
+    (:invert (if (upper-case-p char)
+                 (char-downcase char)
+                 (char-upcase char)))))
+
+(defun parse-symbol (string &optional (package *package*))
+  "Find the symbol named STRING.
+Return the symbol and a flag indicating whether the symbols was found."
+  (multiple-value-bind (sname pname) (tokenize-symbol-thoroughly string)
+    (let ((package (cond ((string= pname "") keyword-package)
+                         (pname              (find-package pname))
+                         (t                  package))))
+      (if package
+          (multiple-value-bind (symbol flag) (find-symbol sname package)
+            (values symbol flag sname package))
+          (values nil nil nil nil)))))
+
+(defun parse-symbol-or-lose (string &optional (package *package*))
+  (multiple-value-bind (symbol status) (parse-symbol string package)
+    (if status
+        (values symbol status)
+        (error "Unknown symbol: ~A [in ~A]" string package))))
+
+;; FIXME: interns the name
+(defun parse-package (string)
+  "Find the package named STRING.
+Return the package or nil."
+  (multiple-value-bind (name pos) 
+      (if (zerop (length string))
+          (values :|| 0)
+          (let ((*package* *swank-io-package*))
+            (ignore-errors (read-from-string string))))
+    (and name
+         (or (symbolp name) 
+             (stringp name))
+         (= (length string) pos)
+         (find-package name))))
+
+(defun unparse-name (string)
+  "Print the name STRING according to the current printer settings."
+  ;; this is intended for package or symbol names
+  (subseq (prin1-to-string (make-symbol string)) 2))
+
+(defun guess-package (string)
+  "Guess which package corresponds to STRING.
+Return nil if no package matches."
+  (or (find-package string)
+      (parse-package string)
+      (if (find #\! string) ; for SBCL
+          (guess-package (substitute #\- #\! string)))))
+
+(defvar *readtable-alist* (default-readtable-alist)
+  "An alist mapping package names to readtables.")
+
+(defun guess-buffer-readtable (package-name)
+  (let ((package (guess-package package-name)))
+    (or (and package 
+             (cdr (assoc (package-name package) *readtable-alist* 
+                         :test #'string=)))
+        *readtable*)))
+
+
+;;;; Evaluation
+
+(defvar *pending-continuations* '()
+  "List of continuations for Emacs. (thread local)")
+
+(defun guess-buffer-package (string)
+  "Return a package for STRING. 
+Fall back to the the current if no such package exists."
+  (or (and string (guess-package string))
+      *package*))
+
+(defun eval-for-emacs (form buffer-package id)
+  "Bind *BUFFER-PACKAGE* to BUFFER-PACKAGE and evaluate FORM.
+Return the result to the continuation ID.
+Errors are trapped and invoke our debugger."
+  (call-with-debugger-hook
+   #'swank-debugger-hook
+   (lambda ()
+     (let (ok result)
+       (unwind-protect
+            (let ((*buffer-package* (guess-buffer-package buffer-package))
+                  (*buffer-readtable* (guess-buffer-readtable buffer-package))
+                  (*pending-continuations* (cons id *pending-continuations*)))
+              (check-type *buffer-package* package)
+              (check-type *buffer-readtable* readtable)
+              ;; APPLY would be cleaner than EVAL. 
+              ;;(setq result (apply (car form) (cdr form)))
+              (setq result (eval form))
+              (run-hook *pre-reply-hook*)
+              (finish-output)
+              (setq ok t))
+         (force-user-output)
+         (send-to-emacs `(:return ,(current-thread)
+                                  ,(if ok
+                                       `(:ok ,result)
+                                       `(:abort))
+                                  ,id)))))))
+
+(defvar *echo-area-prefix* "=> "
+  "A prefix that `format-values-for-echo-area' should use.")
+
+(defun format-values-for-echo-area (values)
+  (with-buffer-syntax ()
+    (let ((*print-readably* nil))
+      (cond ((null values) "; No value")
+            ((and (length= values 1)  (integerp (car values)))
+             (let ((i (car values)))
+               (format nil "~A~D (#x~X, #o~O, #b~B)" 
+                       *echo-area-prefix* i i i i)))
+            (t (format nil "~a~{~S~^, ~}" *echo-area-prefix* values))))))
+
+(defslimefun interactive-eval (string)
+  (with-buffer-syntax ()
+    (let ((values (multiple-value-list (eval (from-string string)))))
+      (fresh-line)
+      (finish-output)
+      (format-values-for-echo-area values))))
+
+(defslimefun eval-and-grab-output (string)
+  (with-buffer-syntax ()
+    (let* ((s (make-string-output-stream))
+           (*standard-output* s)
+           (values (multiple-value-list (eval (from-string string)))))
+      (list (get-output-stream-string s) 
+            (format nil "~{~S~^~%~}" values)))))
+
+(defun eval-region (string)
+  "Evaluate STRING.
+Return the results of the last form as a list and as secondary value the 
+last form."
+  (with-input-from-string (stream string)
+    (let (- values)
+      (loop
+       (let ((form (read stream nil stream)))
+         (when (eq form stream)
+           (return (values values -)))
+         (setq - form)
+         (setq values (multiple-value-list (eval form)))
+         (finish-output))))))
+
+(defslimefun interactive-eval-region (string)
+  (with-buffer-syntax ()
+    (format-values-for-echo-area (eval-region string))))
+
+(defslimefun re-evaluate-defvar (form)
+  (with-buffer-syntax ()
+    (let ((form (read-from-string form)))
+      (destructuring-bind (dv name &optional value doc) form
+	(declare (ignore value doc))
+	(assert (eq dv 'defvar))
+	(makunbound name)
+	(prin1-to-string (eval form))))))
+
+(defvar *swank-pprint-bindings*
+  `((*print-pretty*   . t) 
+    (*print-level*    . nil)
+    (*print-length*   . nil)
+    (*print-circle*   . t)
+    (*print-gensym*   . t)
+    (*print-readably* . nil))
+  "A list of variables bindings during pretty printing.
+Used by pprint-eval.")
+
+(defun swank-pprint (list)
+  "Bind some printer variables and pretty print each object in LIST."
+  (with-buffer-syntax ()
+    (with-bindings *swank-pprint-bindings*
+      (cond ((null list) "; No value")
+            (t (with-output-to-string (*standard-output*)
+                 (dolist (o list)
+                   (pprint o)
+                   (terpri))))))))
+  
+(defslimefun pprint-eval (string)
+  (with-buffer-syntax ()
+    (swank-pprint (multiple-value-list (eval (read-from-string string))))))
+
+(defslimefun set-package (name)
+  "Set *package* to the package named NAME.
+Return the full package-name and the string to use in the prompt."
+  (let ((p (guess-package name)))
+    (assert (packagep p))
+    (setq *package* p)
+    (list (package-name p) (package-string-for-prompt p))))
+
+;;;;; Listener eval
+
+(defvar *listener-eval-function* 'repl-eval)
+
+(defslimefun listener-eval (string)
+  (funcall *listener-eval-function* string))
+
+(defvar *send-repl-results-function* 'send-repl-results-to-emacs)
+
+(defun repl-eval (string)
+  (clear-user-input)
+  (with-buffer-syntax ()
+    (track-package 
+     (lambda ()
+       (multiple-value-bind (values last-form) (eval-region string)
+         (setq *** **  ** *  * (car values)
+               /// //  // /  / values
+               +++ ++  ++ +  + last-form)
+         (funcall *send-repl-results-function* values)))))
+  nil)
+
+(defun track-package (fun)
+  (let ((p *package*))
+    (unwind-protect (funcall fun)
+      (unless (eq *package* p)
+        (send-to-emacs (list :new-package (package-name *package*)
+                             (package-string-for-prompt *package*)))))))
+
+(defun send-repl-results-to-emacs (values)    
+  (fresh-line)
+  (finish-output)
+  (if (null values)
+      (send-to-emacs `(:write-string "; No value" :repl-result))
+      (dolist (v values)
+        (send-to-emacs `(:write-string ,(cat (prin1-to-string v) #\newline)
+                                       :repl-result)))))
+
+(defun cat (&rest strings)
+  "Concatenate all arguments and make the result a string."
+  (with-output-to-string (out)
+    (dolist (s strings)
+      (etypecase s
+        (string (write-string s out))
+        (character (write-char s out))))))
+
+(defun package-string-for-prompt (package)
+  "Return the shortest nickname (or canonical name) of PACKAGE."
+  (unparse-name
+   (or (canonical-package-nickname package)
+       (auto-abbreviated-package-name package)
+       (shortest-package-nickname package))))
+
+(defun canonical-package-nickname (package)
+  "Return the canonical package nickname, if any, of PACKAGE."
+  (let ((name (cdr (assoc (package-name package) *canonical-package-nicknames* 
+                          :test #'string=))))
+    (and name (string name))))
+
+(defun auto-abbreviated-package-name (package)
+  "Return an abbreviated 'name' for PACKAGE. 
+
+N.B. this is not an actual package name or nickname."
+  (when *auto-abbreviate-dotted-packages*
+    (let ((last-dot (position #\. (package-name package) :from-end t)))
+      (when last-dot (subseq (package-name package) (1+ last-dot))))))
+
+(defun shortest-package-nickname (package)
+  "Return the shortest nickname (or canonical name) of PACKAGE."
+  (loop for name in (cons (package-name package) (package-nicknames package))
+        for shortest = name then (if (< (length name) (length shortest))
+                                   name
+                                   shortest)
+              finally (return shortest)))
+
+(defslimefun ed-in-emacs (&optional what)
+  "Edit WHAT in Emacs.
+
+WHAT can be:
+  A pathname or a string,
+  A list (PATHNAME-OR-STRING LINE [COLUMN]),
+  A function name (symbol or cons),
+  NIL.
+
+Returns true if it actually called emacs, or NIL if not."
+  (flet ((pathname-or-string-p (thing)
+           (or (pathnamep thing) (typep thing 'string))))
+    (let ((target
+           (cond ((and (listp what) (pathname-or-string-p (first what)))
+                  (cons (canonicalize-filename (car what)) (cdr what)))
+                 ((pathname-or-string-p what)
+                  (canonicalize-filename what))
+                 ((symbolp what) what)
+                 ((consp what) what)
+                 (t (return-from ed-in-emacs nil)))))
+      (cond
+        (*emacs-connection* (send-oob-to-emacs `(:ed ,target)))
+        ((default-connection)
+         (with-connection ((default-connection))
+           (send-oob-to-emacs `(:ed ,target))))
+        (t nil)))))
+
+(defslimefun inspect-in-emacs (what)
+  "Inspect WHAT in Emacs."
+  (flet ((send-it ()
+           (with-buffer-syntax ()
+             (reset-inspector)
+             (send-oob-to-emacs `(:inspect ,(inspect-object what))))))
+    (cond 
+      (*emacs-connection*
+       (send-it))
+      ((default-connection)
+       (with-connection ((default-connection))
+         (send-it))))
+    what))
+
+(defslimefun value-for-editing (form)
+  "Return a readable value of FORM for editing in Emacs.
+FORM is expected, but not required, to be SETF'able."
+  ;; FIXME: Can we check FORM for setfability? -luke (12/Mar/2005)
+  (with-buffer-syntax ()
+    (prin1-to-string (eval (read-from-string form)))))
+
+(defslimefun commit-edited-value (form value)
+  "Set the value of a setf'able FORM to VALUE.
+FORM and VALUE are both strings from Emacs."
+  (with-buffer-syntax ()
+    (eval `(setf ,(read-from-string form) 
+            ,(read-from-string (concatenate 'string "`" value))))
+    t))
+
+(defun background-message  (format-string &rest args)
+  "Display a message in Emacs' echo area.
+
+Use this function for informative messages only.  The message may even
+be dropped, if we are too busy with other things."
+  (when *emacs-connection*
+    (send-to-emacs `(:background-message 
+                     ,(apply #'format nil format-string args)))))
+
+
+;;;; Debugger
+
+(defun swank-debugger-hook (condition hook)
+  "Debugger function for binding *DEBUGGER-HOOK*.
+Sends a message to Emacs declaring that the debugger has been entered,
+then waits to handle further requests from Emacs. Eventually returns
+after Emacs causes a restart to be invoked."
+  (declare (ignore hook))
+  (cond (*emacs-connection*
+         (debug-in-emacs condition))
+        ((default-connection)
+         (with-connection ((default-connection))
+           (debug-in-emacs condition)))))
+
+(defvar *global-debugger* t
+  "Non-nil means the Swank debugger hook will be installed globally.")
+
+(add-hook *new-connection-hook* 'install-debugger)
+(defun install-debugger (connection)
+  (declare (ignore connection))
+  (when *global-debugger*
+    (install-debugger-globally #'swank-debugger-hook)))
+
+;;;;; Debugger loop
+;;;
+;;; These variables are dynamically bound during debugging.
+;;;
+(defvar *swank-debugger-condition* nil
+  "The condition being debugged.")
+
+(defvar *sldb-level* 0
+  "The current level of recursive debugging.")
+
+(defvar *sldb-initial-frames* 20
+  "The initial number of backtrace frames to send to Emacs.")
+
+(defvar *sldb-restarts* nil
+  "The list of currenlty active restarts.")
+
+(defvar *sldb-stepping-p* nil
+  "True during execution of a step command.")
+
+(defun debug-in-emacs (condition)
+  (let ((*swank-debugger-condition* condition)
+        (*sldb-restarts* (compute-sane-restarts condition))
+        (*package* (or (and (boundp '*buffer-package*)
+                            (symbol-value '*buffer-package*))
+                       *package*))
+        (*sldb-level* (1+ *sldb-level*))
+        (*sldb-stepping-p* nil)
+        (*swank-state-stack* (cons :swank-debugger-hook *swank-state-stack*)))
+    (force-user-output)
+    (call-with-debugging-environment
+     (lambda ()
+       (with-bindings *sldb-printer-bindings*
+         (sldb-loop *sldb-level*))))))
+
+(defun sldb-loop (level)
+  (unwind-protect
+       (catch 'sldb-enter-default-debugger
+         (send-to-emacs
+          (list* :debug (current-thread) level
+                 (debugger-info-for-emacs 0 *sldb-initial-frames*)))
+         (loop (catch 'sldb-loop-catcher
+                 (with-simple-restart (abort "Return to sldb level ~D." level)
+                   (send-to-emacs (list :debug-activate (current-thread)
+                                        level))
+                   (handler-bind ((sldb-condition #'handle-sldb-condition))
+                     (read-from-emacs))))))
+    (send-to-emacs `(:debug-return
+                     ,(current-thread) ,level ,*sldb-stepping-p*))))
+
+(defun handle-sldb-condition (condition)
+  "Handle an internal debugger condition.
+Rather than recursively debug the debugger (a dangerous idea!), these
+conditions are simply reported."
+  (let ((real-condition (original-condition condition)))
+    (send-to-emacs `(:debug-condition ,(current-thread)
+                                      ,(princ-to-string real-condition))))
+  (throw 'sldb-loop-catcher nil))
+
+(defun safe-condition-message (condition)
+  "Safely print condition to a string, handling any errors during
+printing."
+  (let ((*print-pretty* t))
+    (handler-case
+        (format-sldb-condition condition)
+      (error (cond)
+        ;; Beware of recursive errors in printing, so only use the condition
+        ;; if it is printable itself:
+        (format nil "Unable to display error condition~@[: ~A~]"
+                (ignore-errors (princ-to-string cond)))))))
+
+(defun debugger-condition-for-emacs ()
+  (list (safe-condition-message *swank-debugger-condition*)
+        (format nil "   [Condition of type ~S]"
+                (type-of *swank-debugger-condition*))
+        (condition-extras *swank-debugger-condition*)))
+
+(defun format-restarts-for-emacs ()
+  "Return a list of restarts for *swank-debugger-condition* in a
+format suitable for Emacs."
+  (let ((*print-right-margin* most-positive-fixnum))
+    (loop for restart in *sldb-restarts*
+          collect (list (princ-to-string (restart-name restart))
+                        (princ-to-string restart)))))
+
+
+;;;;; SLDB entry points
+
+(defslimefun sldb-break-with-default-debugger ()
+  "Invoke the default debugger by returning from our debugger-loop."
+  (throw 'sldb-enter-default-debugger nil))
+
+(defslimefun backtrace (start end)
+  "Return a list ((I FRAME) ...) of frames from START to END.
+I is an integer describing and FRAME a string."
+  (loop for frame in (compute-backtrace start end)
+        for i from start
+        collect (list i (with-output-to-string (stream)
+                          (handler-case 
+                              (print-frame frame stream)
+                            (t ()
+                              (format stream "[error printing frame]")))))))
+
+(defslimefun debugger-info-for-emacs (start end)
+  "Return debugger state, with stack frames from START to END.
+The result is a list:
+  (condition ({restart}*) ({stack-frame}*) (cont*))
+where
+  condition   ::= (description type [extra])
+  restart     ::= (name description)
+  stack-frame ::= (number description)
+  extra       ::= (:references and other random things)
+  cont        ::= continutation
+condition---a pair of strings: message, and type.  If show-source is
+not nil it is a frame number for which the source should be displayed.
+
+restart---a pair of strings: restart name, and description.
+
+stack-frame---a number from zero (the top), and a printed
+representation of the frame's call.
+
+continutation---the id of a pending Emacs continuation.
+
+Below is an example return value. In this case the condition was a
+division by zero (multi-line description), and only one frame is being
+fetched (start=0, end=1).
+
+ ((\"Arithmetic error DIVISION-BY-ZERO signalled.
+Operation was KERNEL::DIVISION, operands (1 0).\"
+   \"[Condition of type DIVISION-BY-ZERO]\")
+  ((\"ABORT\" \"Return to Slime toplevel.\")
+   (\"ABORT\" \"Return to Top-Level.\"))
+  ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\"))
+  (4))"
+  (list (debugger-condition-for-emacs)
+        (format-restarts-for-emacs)
+        (backtrace start end)
+        *pending-continuations*))
+
+(defun nth-restart (index)
+  (nth index *sldb-restarts*))
+
+(defslimefun invoke-nth-restart (index)
+  (invoke-restart-interactively (nth-restart index)))
+
+(defslimefun sldb-abort ()
+  (invoke-restart (find 'abort *sldb-restarts* :key #'restart-name)))
+
+(defslimefun sldb-continue ()
+  (continue))
+
+(defslimefun throw-to-toplevel ()
+  "Invoke the ABORT-REQUEST restart abort an RPC from Emacs.
+If we are not evaluating an RPC then ABORT instead."
+  (let ((restart (find-restart *sldb-quit-restart*)))
+    (cond (restart (invoke-restart restart))
+          (t (format nil
+                     "Restart not found: ~a"
+                     *sldb-quit-restart*)))))
+
+(defslimefun invoke-nth-restart-for-emacs (sldb-level n)
+  "Invoke the Nth available restart.
+SLDB-LEVEL is the debug level when the request was made. If this
+has changed, ignore the request."
+  (when (= sldb-level *sldb-level*)
+    (invoke-nth-restart n)))
+
+(defun wrap-sldb-vars (form)
+  `(let ((*sldb-level* ,*sldb-level*))
+     ,form))
+
+(defslimefun eval-string-in-frame (string index)
+  (to-string (eval-in-frame (wrap-sldb-vars (from-string string))
+                            index)))
+
+(defslimefun pprint-eval-string-in-frame (string index)
+  (swank-pprint
+   (multiple-value-list 
+    (eval-in-frame (wrap-sldb-vars (from-string string)) index))))
+
+(defslimefun frame-locals-for-emacs (index)
+  "Return a property list ((&key NAME ID VALUE) ...) describing
+the local variables in the frame INDEX."
+  (mapcar (lambda (frame-locals)
+            (destructuring-bind (&key name id value) frame-locals
+              (list :name (prin1-to-string name) :id id
+                    :value (to-string value))))
+          (frame-locals index)))
+
+(defslimefun frame-catch-tags-for-emacs (frame-index)
+  (mapcar #'to-string (frame-catch-tags frame-index)))
+
+(defslimefun sldb-disassemble (index)
+  (with-output-to-string (*standard-output*)
+    (disassemble-frame index)))
+
+(defslimefun sldb-return-from-frame (index string)
+  (let ((form (from-string string)))
+    (to-string (multiple-value-list (return-from-frame index form)))))
+
+(defslimefun sldb-break (name)
+  (with-buffer-syntax ()
+    (sldb-break-at-start (read-from-string name))))
+
+(defmacro define-stepper-function (name backend-function-name)
+  `(defslimefun ,name (frame)
+     (cond ((sldb-stepper-condition-p *swank-debugger-condition*)
+            (setq *sldb-stepping-p* t)
+            (,backend-function-name))
+           ((find-restart 'continue)
+         (activate-stepping frame)
+         (setq *sldb-stepping-p* t)
+         (continue))
+        (t
+            (error "Not currently single-stepping, and no continue restart available.")))))
+
+(define-stepper-function sldb-step sldb-step-into)
+(define-stepper-function sldb-next sldb-step-next)
+(define-stepper-function sldb-out  sldb-step-out)
+
+
+;;;; Compilation Commands.
+
+(defvar *compiler-notes* '()
+  "List of compiler notes for the last compilation unit.")
+
+(defun clear-compiler-notes ()  
+  (setf *compiler-notes* '()))
+
+(defun canonicalize-filename (filename)
+  (namestring (truename filename)))
+
+(defslimefun compiler-notes-for-emacs ()
+  "Return the list of compiler notes for the last compilation unit."
+  (reverse *compiler-notes*))
+
+(defun measure-time-interval (fn)
+  "Call FN and return the first return value and the elapsed time.
+The time is measured in microseconds."
+  (declare (type function fn))
+  (let ((before (get-internal-real-time)))
+    (values
+     (funcall fn)
+     (* (- (get-internal-real-time) before)
+        (/ 1000000 internal-time-units-per-second)))))
+
+(defun record-note-for-condition (condition)
+  "Record a note for a compiler-condition."
+  (push (make-compiler-note condition) *compiler-notes*))
+
+(defun make-compiler-note (condition)
+  "Make a compiler note data structure from a compiler-condition."
+  (declare (type compiler-condition condition))
+  (list* :message (message condition)
+         :severity (severity condition)
+         :location (location condition)
+         :references (references condition)
+         (let ((s (short-message condition)))
+           (if s (list :short-message s)))))
+
+(defun swank-compiler (function)
+  (clear-compiler-notes)
+  (multiple-value-bind (result usecs)
+      (with-simple-restart (abort "Abort SLIME compilation.")
+        (handler-bind ((compiler-condition #'record-note-for-condition))
+          (measure-time-interval function)))
+    ;; WITH-SIMPLE-RESTART returns (values nil t) if its restart is invoked;
+    ;; unfortunately the SWANK protocol doesn't support returning multiple
+    ;; values, so we gotta convert it explicitely to a list in either case.
+    (if (and (not result) (eq usecs 't))
+        (list nil nil)
+        (list (to-string result)
+              (format nil "~,2F" (/ usecs 1000000.0))))))
+
+(defslimefun compile-file-for-emacs (filename load-p)
+  "Compile FILENAME and, when LOAD-P, load the result.
+Record compiler notes signalled as `compiler-condition's."
+  (with-buffer-syntax ()
+    (let ((*compile-print* nil))
+      (swank-compiler 
+       (lambda ()
+         (swank-compile-file filename load-p
+                             (or (guess-external-format filename)
+                                 :default)))))))
+
+(defslimefun compile-string-for-emacs (string buffer position directory)
+  "Compile STRING (exerpted from BUFFER at POSITION).
+Record compiler notes signalled as `compiler-condition's."
+  (with-buffer-syntax ()
+    (swank-compiler
+     (lambda () 
+       (let ((*compile-print* nil) (*compile-verbose* t))
+         (swank-compile-string string :buffer buffer :position position 
+                               :directory directory))))))
+  
+(defun file-newer-p (new-file old-file)
+  "Returns true if NEW-FILE is newer than OLD-FILE."
+  (> (file-write-date new-file) (file-write-date old-file)))
+
+(defun requires-compile-p (source-file)
+  (let ((fasl-file (probe-file (compile-file-pathname source-file))))
+    (or (not fasl-file)
+        (file-newer-p source-file fasl-file))))
+
+(defslimefun compile-file-if-needed (filename loadp)
+  (cond ((requires-compile-p filename)
+         (compile-file-for-emacs filename loadp))
+        (loadp
+         (load (compile-file-pathname filename))
+         nil)))
+
+
+;;;; Loading
+
+(defslimefun load-file (filename)
+  (to-string (load filename)))
+
+(defslimefun load-file-set-package (filename &optional package)
+  (load-file filename)
+  (if package
+      (set-package package)))
+
+
+;;;;; swank-require
+
+(defslimefun swank-require (module &optional filename)
+  "Load the module MODULE."
+  (require module (or filename (module-filename module)))
+  nil)
+
+(defvar *find-module* 'find-module
+  "Pluggable function to locate modules.
+The function receives a module name as argument and should return
+the filename of the module (or nil if the file doesn't exist).")
+
+(defun module-filename (module)
+  "Return the filename for the module MODULE."
+  (or (funcall *find-module* module)
+      (error "Can't locate module: ~s" module)))
+
+;;;;;; Simple *find-module* function.
+
+(defun merged-directory (dirname defaults)
+  (pathname-directory
+   (merge-pathnames 
+    (make-pathname :directory `(:relative ,dirname) :defaults defaults)
+    defaults)))
+
+(defvar *load-path*
+  (list (make-pathname :directory (merged-directory "contrib" *load-truename*)
+                       :name nil :type nil :version nil
+                       :defaults *load-truename*))
+  "A list of directories to search for modules.")
+
+(defun module-canditates (name dir)
+  (list (compile-file-pathname (make-pathname :name name :defaults dir))
+        (make-pathname :name name :type "lisp" :defaults dir)))
+
+(defun find-module (module)
+  (let ((name (string-downcase module)))
+    (some (lambda (dir) (some #'probe-file (module-canditates name dir)))
+          *load-path*)))
+
+
+;;;; Macroexpansion
+
+(defvar *macroexpand-printer-bindings*
+  '((*print-circle* . nil)
+    (*print-pretty* . t)
+    (*print-escape* . t)
+    (*print-lines* . nil)
+    (*print-level* . nil)
+    (*print-length* . nil)))
+
+(defun apply-macro-expander (expander string)
+  (with-buffer-syntax ()
+    (with-bindings *macroexpand-printer-bindings*
+      (prin1-to-string (funcall expander (from-string string))))))
+
+(defslimefun swank-macroexpand-1 (string)
+  (apply-macro-expander #'macroexpand-1 string))
+
+(defslimefun swank-macroexpand (string)
+  (apply-macro-expander #'macroexpand string))
+
+(defslimefun swank-macroexpand-all (string)
+  (apply-macro-expander #'macroexpand-all string))
+
+(defslimefun swank-compiler-macroexpand-1 (string)
+  (apply-macro-expander #'compiler-macroexpand-1 string))
+
+(defslimefun swank-compiler-macroexpand (string)
+  (apply-macro-expander #'compiler-macroexpand string))
+
+(defslimefun disassemble-symbol (name)
+  (with-buffer-syntax ()
+    (with-output-to-string (*standard-output*)
+      (let ((*print-readably* nil))
+        (disassemble (fdefinition (from-string name)))))))
+
+
+;;;; Simple completion
+
+(defslimefun simple-completions (string buffer-package)
+  "Return a list of completions for the string STRING."
+  (let ((strings (all-completions string buffer-package #'prefix-match-p)))
+    (list strings (longest-common-prefix strings))))
+
+(defun all-completions (string buffer-package test)
+  (multiple-value-bind (name pname intern) (tokenize-symbol string)
+    (let* ((extern (and pname (not intern)))
+	   (pack (cond ((equal pname "") keyword-package)
+		       ((not pname) (guess-buffer-package buffer-package))
+		       (t (guess-package pname))))
+	   (test (lambda (sym) (funcall test name (unparse-symbol sym))))
+	   (syms (and pack (matching-symbols pack extern test))))
+      (format-completion-set (mapcar #'unparse-symbol syms) intern pname))))
+
+(defun matching-symbols (package external test)
+  (let ((test (if external 
+		  (lambda (s)
+		    (and (symbol-external-p s package) 
+			 (funcall test s)))
+		  test))
+	(result '()))
+    (do-symbols (s package)
+      (when (funcall test s) 
+	(push s result)))
+    (remove-duplicates result)))
+
+(defun unparse-symbol (symbol)
+  (let ((*print-case* (case (readtable-case *readtable*) 
+                        (:downcase :upcase)
+                        (t :downcase))))
+    (unparse-name (symbol-name symbol))))
+
+(defun prefix-match-p (prefix string)
+  "Return true if PREFIX is a prefix of STRING."
+  (not (mismatch prefix string :end2 (min (length string) (length prefix)))))
+
+(defun longest-common-prefix (strings)
+  "Return the longest string that is a common prefix of STRINGS."
+  (if (null strings)
+      ""
+      (flet ((common-prefix (s1 s2)
+               (let ((diff-pos (mismatch s1 s2)))
+                 (if diff-pos (subseq s1 0 diff-pos) s1))))
+        (reduce #'common-prefix strings))))
+
+(defun format-completion-set (strings internal-p package-name)
+  "Format a set of completion strings.
+Returns a list of completions with package qualifiers if needed."
+  (mapcar (lambda (string) (untokenize-symbol package-name internal-p string))
+          (sort strings #'string<)))
+
+
+;;;; Simple arglist display
+
+(defslimefun operator-arglist (name package)
+  (ignore-errors
+    (let ((args (arglist (parse-symbol name (guess-buffer-package package))))
+          (*print-escape* nil))
+      (cond ((eq args :not-available) nil)
+	    (t (format nil "(~a ~/pprint-fill/)" name args))))))
+
+
+;;;; Documentation
+
+(defslimefun apropos-list-for-emacs  (name &optional external-only 
+                                           case-sensitive package)
+  "Make an apropos search for Emacs.
+The result is a list of property lists."
+  (let ((package (if package
+                     (or (parse-package package)
+                         (error "No such package: ~S" package)))))
+    ;; The MAPCAN will filter all uninteresting symbols, i.e. those
+    ;; who cannot be meaningfully described.
+    (mapcan (listify #'briefly-describe-symbol-for-emacs)
+            (sort (remove-duplicates
+                   (apropos-symbols name external-only case-sensitive package))
+                  #'present-symbol-before-p))))
+
+(defun briefly-describe-symbol-for-emacs (symbol)
+  "Return a property list describing SYMBOL.
+Like `describe-symbol-for-emacs' but with at most one line per item."
+  (flet ((first-line (string)
+           (let ((pos (position #\newline string)))
+             (if (null pos) string (subseq string 0 pos)))))
+    (let ((desc (map-if #'stringp #'first-line 
+                        (describe-symbol-for-emacs symbol))))
+      (if desc 
+          (list* :designator (to-string symbol) desc)))))
+
+(defun map-if (test fn &rest lists)
+  "Like (mapcar FN . LISTS) but only call FN on objects satisfying TEST.
+Example:
+\(map-if #'oddp #'- '(1 2 3 4 5)) => (-1 2 -3 4 -5)"
+  (apply #'mapcar
+         (lambda (x) (if (funcall test x) (funcall fn x) x))
+         lists))
+
+(defun listify (f)
+  "Return a function like F, but which returns any non-null value
+wrapped in a list."
+  (lambda (x)
+    (let ((y (funcall f x)))
+      (and y (list y)))))
+
+(defun present-symbol-before-p (x y)
+  "Return true if X belongs before Y in a printed summary of symbols.
+Sorted alphabetically by package name and then symbol name, except
+that symbols accessible in the current package go first."
+  (declare (type symbol x y))
+  (flet ((accessible (s)
+           ;; Test breaks on NIL for package that does not inherit it
+           (eq (find-symbol (symbol-name s) *buffer-package*) s)))
+    (let ((ax (accessible x)) (ay (accessible y)))
+      (cond ((and ax ay) (string< (symbol-name x) (symbol-name y)))
+            (ax t)
+            (ay nil)
+            (t (let ((px (symbol-package x)) (py (symbol-package y)))
+                 (if (eq px py)
+                     (string< (symbol-name x) (symbol-name y))
+                     (string< (package-name px) (package-name py)))))))))
+
+(let ((regex-hash (make-hash-table :test #'equal)))
+  (defun compiled-regex (regex-string)
+    (or (gethash regex-string regex-hash)
+        (setf (gethash regex-string regex-hash)
+              (if (zerop (length regex-string))
+                  (lambda (s) (check-type s string) t)
+                  (compile nil (slime-nregex:regex-compile regex-string)))))))
+
+(defun make-regexp-matcher (string case-sensitive)
+  (let* ((case-modifier (if case-sensitive #'string #'string-upcase))
+         (regex (compiled-regex (funcall case-modifier string))))
+    (lambda (symbol)
+      (funcall regex (funcall case-modifier symbol)))))
+
+(defun apropos-symbols (string external-only case-sensitive package)
+  (let ((packages (or package (remove (find-package :keyword)
+                                      (list-all-packages))))
+        (matcher  (make-regexp-matcher string case-sensitive))
+        (result))
+    (with-package-iterator (next packages :external :internal)
+      (loop (multiple-value-bind (morep symbol) (next)
+              (cond ((not morep) (return))
+                    ((and (if external-only (symbol-external-p symbol) t)
+                          (funcall matcher symbol))
+                     (push symbol result))))))
+    result))
+
+(defun call-with-describe-settings (fn)
+  (let ((*print-readably* nil))
+    (funcall fn)))
+
+(defmacro with-describe-settings ((&rest _) &body body)
+  (declare (ignore _))
+  `(call-with-describe-settings (lambda () , at body)))
+    
+(defun describe-to-string (object)
+  (with-describe-settings ()
+    (with-output-to-string (*standard-output*)
+      (describe object))))
+
+(defslimefun describe-symbol (symbol-name)
+  (with-buffer-syntax ()
+    (describe-to-string (parse-symbol-or-lose symbol-name))))
+
+(defslimefun describe-function (name)
+  (with-buffer-syntax ()
+    (let ((symbol (parse-symbol-or-lose name)))
+      (describe-to-string (or (macro-function symbol)
+                              (symbol-function symbol))))))
+
+(defslimefun describe-definition-for-emacs (name kind)
+  (with-buffer-syntax ()
+    (with-describe-settings ()
+      (with-output-to-string (*standard-output*)
+        (describe-definition (parse-symbol-or-lose name) kind)))))
+
+(defslimefun documentation-symbol (symbol-name &optional default)
+  (with-buffer-syntax ()
+    (multiple-value-bind (sym foundp) (parse-symbol symbol-name)
+      (if foundp
+          (let ((vdoc (documentation sym 'variable))
+                (fdoc (documentation sym 'function)))
+            (or (and (or vdoc fdoc)
+                     (concatenate 'string
+                                  fdoc
+                                  (and vdoc fdoc '(#\Newline #\Newline))
+                                  vdoc))
+                default))
+          default))))
+
+
+;;;; Package Commands
+
+(defslimefun list-all-package-names (&optional nicknames)
+  "Return a list of all package names.
+Include the nicknames if NICKNAMES is true."
+  (mapcar #'unparse-name
+          (if nicknames
+              (mapcan #'package-names (list-all-packages))
+              (mapcar #'package-name  (list-all-packages)))))
+
+
+;;;; Tracing
+
+;; Use eval for the sake of portability... 
+(defun tracedp (fspec)
+  (member fspec (eval '(trace))))
+
+(defslimefun swank-toggle-trace (spec-string)
+  (let ((spec (from-string spec-string)))
+    (cond ((consp spec) ; handle complicated cases in the backend
+           (toggle-trace spec))
+          ((tracedp spec)
+	   (eval `(untrace ,spec))
+	   (format nil "~S is now untraced." spec))
+	  (t
+           (eval `(trace ,spec))
+	   (format nil "~S is now traced." spec)))))
+
+(defslimefun untrace-all ()
+  (untrace))
+
+(defslimefun redirect-trace-output (target)
+  (setf (connection.trace-output *emacs-connection*)
+        (make-output-stream-for-target *emacs-connection* target))
+  nil)
+
+
+;;;; Undefing
+
+(defslimefun undefine-function (fname-string)
+  (let ((fname (from-string fname-string)))
+    (format nil "~S" (fmakunbound fname))))
+
+
+;;;; Profiling
+
+(defun profiledp (fspec)
+  (member fspec (profiled-functions)))
+
+(defslimefun toggle-profile-fdefinition (fname-string)
+  (let ((fname (from-string fname-string)))
+    (cond ((profiledp fname)
+	   (unprofile fname)
+	   (format nil "~S is now unprofiled." fname))
+	  (t
+           (profile fname)
+	   (format nil "~S is now profiled." fname)))))
+
+
+;;;; Source Locations
+
+(defslimefun find-definitions-for-emacs (name)
+  "Return a list ((DSPEC LOCATION) ...) of definitions for NAME.
+DSPEC is a string and LOCATION a source location. NAME is a string."
+  (multiple-value-bind (sexp error)
+      (ignore-errors (values (from-string name)))
+    (unless error
+      (loop for (dspec loc) in (find-definitions sexp)
+         collect (list (to-string dspec) loc)))))
+
+(defun alistify (list key test)
+  "Partition the elements of LIST into an alist.  KEY extracts the key
+from an element and TEST is used to compare keys."
+  (declare (type function key))
+  (let ((alist '()))
+    (dolist (e list)
+      (let* ((k (funcall key e))
+	     (probe (assoc k alist :test test)))
+	(if probe
+	    (push e (cdr probe))
+            (push (cons k (list e)) alist))))
+    alist))
+
+(defun location-position< (pos1 pos2)
+  (cond ((and (position-p pos1) (position-p pos2))
+         (< (position-pos pos1)
+            (position-pos pos2)))
+        (t nil)))
+
+(defun partition (list test key)
+  (declare (type function test key))
+  (loop for e in list
+	if (funcall test (funcall key e)) collect e into yes
+	else collect e into no
+	finally (return (values yes no))))
+
+(defstruct (xref (:conc-name xref.)
+                 (:type list))
+  dspec location)
+
+(defun location-valid-p (location)
+  (eq (car location) :location))
+
+(defun xref-buffer (xref)
+  (location-buffer (xref.location xref)))
+
+(defun xref-position (xref)
+  (location-buffer (xref.location xref)))
+
+(defun group-xrefs (xrefs)
+  "Group XREFS, a list of the form ((DSPEC LOCATION) ...) by location.
+The result is a list of the form ((LOCATION . ((DSPEC . LOCATION) ...)) ...)."
+  (multiple-value-bind (resolved errors)
+      (partition xrefs #'location-valid-p #'xref.location)
+    (let ((alist (alistify resolved #'xref-buffer #'equal)))
+      (append
+       (loop for (buffer . list) in alist
+             collect (cons (second buffer)
+                           (mapcar (lambda (xref)
+                                     (cons (to-string (xref.dspec xref))
+                                           (xref.location xref)))
+                                   (sort list #'location-position<
+                                         :key #'xref-position))))
+       (if errors
+           (list (cons "Unresolved"
+                       (mapcar (lambda (xref)
+                                 (cons (to-string (xref.dspec xref))
+                                       (xref.location xref)))
+                               errors))))))))
+
+(defslimefun xref (type symbol-name)
+  (let ((symbol (parse-symbol-or-lose symbol-name *buffer-package*)))
+    (group-xrefs
+     (ecase type
+       (:calls (who-calls symbol))
+       (:calls-who (calls-who symbol))
+       (:references (who-references symbol))
+       (:binds (who-binds symbol))
+       (:sets (who-sets symbol))
+       (:macroexpands (who-macroexpands symbol))
+       (:specializes (who-specializes symbol))
+       (:callers (list-callers symbol))
+       (:callees (list-callees symbol))))))
+
+
+;;;; Inspecting
+
+(defun common-seperated-spec (list &optional (callback (lambda (v) 
+							 `(:value ,v))))
+  (butlast
+   (loop
+      for i in list
+      collect (funcall callback i)
+      collect ", ")))
+
+(defun inspector-princ (list)
+  "Like princ-to-string, but don't rewrite (function foo) as #'foo. 
+Do NOT pass circular lists to this function."
+  (let ((*print-pprint-dispatch* (copy-pprint-dispatch)))
+    (set-pprint-dispatch '(cons (member function)) nil)
+    (princ-to-string list)))
+
+(defmethod inspect-for-emacs ((object cons) inspector)
+  (declare (ignore inspector))
+  (if (consp (cdr object))
+      (inspect-for-emacs-list object)
+      (inspect-for-emacs-simple-cons object)))
+
+(defun inspect-for-emacs-simple-cons (cons)
+  (values "A cons cell."
+          (label-value-line* 
+           ('car (car cons))
+           ('cdr (cdr cons)))))
+
+(defun inspect-for-emacs-list (list)
+  (let ((maxlen 40))
+    (multiple-value-bind (length tail) (safe-length list)
+      (flet ((frob (title list)
+               (let (lines)
+                 (loop for i from 0 for rest on list do
+                       (if (consp (cdr rest))     ; e.g. (A . (B . ...))
+                           (push (label-value-line i (car rest)) lines)
+                           (progn                 ; e.g. (A . NIL) or (A . B)
+                             (push (label-value-line i (car rest) :newline nil) lines)
+                             (when (cdr rest)
+                               (push '((:newline)) lines)
+                               (push (label-value-line ':tail () :newline nil) lines))
+                             (loop-finish)))
+                       finally
+                       (setf lines (reduce #'append (nreverse lines) :from-end t)))
+                 (values title (append '("Elements:" (:newline)) lines)))))
+                               
+        (cond ((not length)             ; circular
+               (frob "A circular list."
+                     (cons (car list)
+                           (ldiff (cdr list) list))))
+              ((and (<= length maxlen) (not tail))
+               (frob "A proper list." list))
+              (tail
+               (frob "An improper list." list))
+              (t
+               (frob "A proper list." list)))))))
+
+;; (inspect-for-emacs-list '#1=(a #1# . #1# ))
+
+(defun safe-length (list)
+  "Similar to `list-length', but avoid errors on improper lists.
+Return two values: the length of the list and the last cdr.
+NIL is returned if the list is circular."
+  (do ((n 0 (+ n 2))                    ;Counter.
+       (fast list (cddr fast))          ;Fast pointer: leaps by 2.
+       (slow list (cdr slow)))          ;Slow pointer: leaps by 1.
+      (nil)
+    (cond ((null fast) (return (values n nil)))
+          ((not (consp fast)) (return (values n fast)))
+          ((null (cdr fast)) (return (values (1+ n) (cdr fast))))
+          ((and (eq fast slow) (> n 0)) (return nil))
+          ((not (consp (cdr fast))) (return (values (1+ n) (cdr fast)))))))
+
+(defvar *slime-inspect-contents-limit* nil "How many elements of
+ a hash table or array to show by default. If table has more than
+ this then offer actions to view more. Set to nil for no limit." )
+
+(defmethod inspect-for-emacs ((ht hash-table) inspector)
+  (declare (ignore inspector))
+  (values (prin1-to-string ht)
+          (append
+           (label-value-line*
+            ("Count" (hash-table-count ht))
+            ("Size" (hash-table-size ht))
+            ("Test" (hash-table-test ht))
+            ("Rehash size" (hash-table-rehash-size ht))
+            ("Rehash threshold" (hash-table-rehash-threshold ht)))
+           (let ((weakness (hash-table-weakness ht)))
+             (when weakness
+               `("Weakness: " (:value ,weakness) (:newline))))
+           (unless (zerop (hash-table-count ht))
+             `((:action "[clear hashtable]" ,(lambda () (clrhash ht))) (:newline)
+               "Contents: " (:newline)))
+	   (if (and *slime-inspect-contents-limit*
+		    (>= (hash-table-count ht) *slime-inspect-contents-limit*))
+	       (inspect-bigger-piece-actions ht (hash-table-count ht))
+	       nil)
+           (loop for key being the hash-keys of ht
+                 for value being the hash-values of ht
+                 repeat (or *slime-inspect-contents-limit* most-positive-fixnum)
+                 append `((:value ,key) " = " (:value ,value)
+                          " " (:action "[remove entry]"
+                               ,(let ((key key))
+                                  (lambda () (remhash key ht))))
+                          (:newline))))))
+
+(defun inspect-bigger-piece-actions (thing size)
+  (append 
+   (if (> size *slime-inspect-contents-limit*)
+       (list (inspect-show-more-action thing)
+	     '(:newline))
+       nil)
+   (list (inspect-whole-thing-action thing  size)
+	 '(:newline))))
+
+(defun inspect-whole-thing-action (thing size)
+  `(:action ,(format nil "Inspect all ~a elements." 
+		      size)
+	    ,(lambda() 
+	       (let ((*slime-inspect-contents-limit* nil))
+		 (swank::inspect-object thing)))))
+
+(defun inspect-show-more-action (thing)
+  `(:action ,(format nil "~a elements shown. Prompt for how many to inspect..." 
+		     *slime-inspect-contents-limit* )
+	    ,(lambda() 
+	       (let ((*slime-inspect-contents-limit* 
+		      (progn (format t "How many elements should be shown? ") (read))))
+		 (swank::inspect-object thing)))))
+
+(defmethod inspect-for-emacs ((array array) inspector)
+  (declare (ignore inspector))
+  (values "An array."
+          (append
+           (label-value-line*
+            ("Dimensions" (array-dimensions array))
+            ("Its element type is" (array-element-type array))
+            ("Total size" (array-total-size array))
+            ("Adjustable" (adjustable-array-p array)))
+           (when (array-has-fill-pointer-p array)
+             (label-value-line "Fill pointer" (fill-pointer array)))
+           '("Contents:" (:newline))
+           (if (and *slime-inspect-contents-limit*
+		    (>= (array-total-size array) *slime-inspect-contents-limit*))
+	       (inspect-bigger-piece-actions array  (length array))
+	       nil)
+           (loop for i below (or *slime-inspect-contents-limit* (array-total-size array))
+                 append (label-value-line i (row-major-aref array i))))))
+
+(defmethod inspect-for-emacs ((char character) inspector)
+  (declare (ignore inspector))
+  (values "A character."
+          (append 
+           (label-value-line*
+            ("Char code" (char-code char))
+            ("Lower cased" (char-downcase char))
+            ("Upper cased" (char-upcase char)))
+           (if (get-macro-character char)
+               `("In the current readtable (" 
+                 (:value ,*readtable*) ") it is a macro character: "
+                 (:value ,(get-macro-character char)))))))
+
+(defvar *inspectee*)
+(defvar *inspectee-parts*) 
+(defvar *inspectee-actions*)
+(defvar *inspector-stack* '())
+(defvar *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))
+(declaim (type vector *inspector-history*))
+(defvar *inspect-length* 30)
+(defvar *default-inspector* (make-default-inspector))
+
+(defun reset-inspector ()
+  (setq *inspectee* nil
+        *inspector-stack* nil
+        *inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0)
+        *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)
+        *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
+
+;; FIXME: Unused?
+(defun valid-function-name-p (form)
+  (or (and (not (null form))
+           (not (eq form t))
+           (symbolp form))
+      (and (consp form)
+           (second form)
+           (not (third form))
+           (eq (first form) 'setf))))
+
+(defslimefun init-inspector (string)
+  (with-buffer-syntax ()
+    (reset-inspector)
+    (inspect-object (eval (read-from-string string)))))
+
+(defun print-part-to-string (value)
+  (let ((string (to-string value))
+        (pos (position value *inspector-history*)))
+    (if pos
+        (format nil "#~D=~A" pos string)
+        string)))
+
+(defun inspector-content-for-emacs (specs)
+  (loop for part in specs collect 
+        (etypecase part
+          (null ; XXX encourages sloppy programming
+           nil)
+          (string part)
+          (cons (destructure-case part
+                  ((:newline) 
+                   (string #\newline))
+                  ((:value obj &optional str) 
+                   (value-part-for-emacs obj str))
+                  ((:action label lambda &key (refreshp t)) 
+                   (action-part-for-emacs label lambda refreshp)))))))
+
+(defun assign-index (object vector)
+  (let ((index (fill-pointer vector)))
+    (vector-push-extend object vector)
+    index))
+
+(defun value-part-for-emacs (object string)
+  (list :value 
+        (or string (print-part-to-string object))
+        (assign-index object *inspectee-parts*)))
+
+(defun action-part-for-emacs (label lambda refreshp)
+  (list :action label (assign-index (list lambda refreshp)
+                                    *inspectee-actions*)))
+
+(defun inspect-object (object &optional (inspector *default-inspector*))
+  (push (setq *inspectee* object) *inspector-stack*)
+  (unless (find object *inspector-history*)
+    (vector-push-extend object *inspector-history*))
+  (let ((*print-pretty* nil)            ; print everything in the same line
+        (*print-circle* t)
+        (*print-readably* nil))
+    (multiple-value-bind (title content) (inspect-for-emacs object inspector)
+      (list :title title
+            :type (to-string (type-of object))
+            :content (inspector-content-for-emacs content)))))
+
+(defslimefun inspector-nth-part (index)
+  (aref *inspectee-parts* index))
+
+(defslimefun inspect-nth-part (index)
+  (with-buffer-syntax ()
+    (inspect-object (inspector-nth-part index))))
+
+(defslimefun inspector-call-nth-action (index &rest args)
+  (destructuring-bind (action-lambda refreshp)
+      (aref *inspectee-actions* index)
+    (apply action-lambda args)
+    (if refreshp
+        (inspect-object (pop *inspector-stack*))
+        ;; tell emacs that we don't want to refresh the inspector buffer
+        nil)))
+
+(defslimefun inspector-pop ()
+  "Drop the inspector stack and inspect the second element.  Return
+nil if there's no second element."
+  (with-buffer-syntax ()
+    (cond ((cdr *inspector-stack*)
+           (pop *inspector-stack*)
+           (inspect-object (pop *inspector-stack*)))
+          (t nil))))
+
+(defslimefun inspector-next ()
+  "Inspect the next element in the *inspector-history*."
+  (with-buffer-syntax ()
+    (let ((position (position *inspectee* *inspector-history*)))
+      (cond ((= (1+ position) (length *inspector-history*))
+             nil)
+            (t (inspect-object (aref *inspector-history* (1+ position))))))))
+
+(defslimefun inspector-reinspect ()
+  (inspect-object *inspectee*))
+
+(defslimefun quit-inspector ()
+  (reset-inspector)
+  nil)
+
+(defslimefun describe-inspectee ()
+  "Describe the currently inspected object."
+  (with-buffer-syntax ()
+    (describe-to-string *inspectee*)))
+
+(defslimefun pprint-inspector-part (index)
+  "Pretty-print the currently inspected object."
+  (with-buffer-syntax ()
+    (swank-pprint (list (inspector-nth-part index)))))
+
+(defslimefun inspect-in-frame (string index)
+  (with-buffer-syntax ()
+    (reset-inspector)
+    (inspect-object (eval-in-frame (from-string string) index))))
+
+(defslimefun inspect-current-condition ()
+  (with-buffer-syntax ()
+    (reset-inspector)
+    (inspect-object *swank-debugger-condition*)))
+
+(defslimefun inspect-frame-var (frame var)
+  (with-buffer-syntax ()
+    (reset-inspector)
+    (inspect-object (frame-var-value frame var))))
+
+
+;;;; Thread listing
+
+(defvar *thread-list* ()
+  "List of threads displayed in Emacs.  We don't care a about
+synchronization issues (yet).  There can only be one thread listing at
+a time.")
+
+(defslimefun list-threads ()
+  "Return a list ((NAME DESCRIPTION) ...) of all threads."
+  (setq *thread-list* (all-threads))
+  (loop for thread in  *thread-list* 
+       for name = (thread-name thread)
+        collect (list (if (symbolp name) (symbol-name name) name)
+                      (thread-status thread)
+                      (thread-id thread))))
+
+(defslimefun quit-thread-browser ()
+  (setq *thread-list* nil))
+
+(defun nth-thread (index)
+  (nth index *thread-list*))
+
+(defslimefun debug-nth-thread (index)
+  (let ((connection *emacs-connection*))
+    (interrupt-thread (nth-thread index)
+                      (lambda ()
+			(with-connection (connection)
+			  (simple-break))))))
+
+(defslimefun kill-nth-thread (index)
+  (kill-thread (nth-thread index)))
+
+(defslimefun start-swank-server-in-thread (index port-file-name)
+  "Interrupt the INDEXth thread and make it start a swank server.
+The server port is written to PORT-FILE-NAME."
+  (interrupt-thread (nth-thread index)
+                    (lambda ()
+                      (start-server port-file-name :style nil))))
+
+;;;; Class browser
+
+(defun mop-helper (class-name fn)
+  (let ((class (find-class class-name nil)))
+    (if class
+        (mapcar (lambda (x) (to-string (class-name x)))
+                (funcall fn class)))))
+
+(defslimefun mop (type symbol-name)
+  "Return info about classes using mop.
+
+    When type is:
+     :subclasses - return the list of subclasses of class.
+     :superclasses - return the list of superclasses of class."
+  (let ((symbol (parse-symbol symbol-name *buffer-package*)))
+    (ecase type
+      (:subclasses
+       (mop-helper symbol #'swank-mop:class-direct-subclasses))
+      (:superclasses 
+       (mop-helper symbol #'swank-mop:class-direct-superclasses)))))
+
+
+;;;; Automatically synchronized state
+;;;
+;;; Here we add hooks to push updates of relevant information to
+;;; Emacs.
+
+;;;;; *FEATURES*
+
+(defun sync-features-to-emacs ()
+  "Update Emacs if any relevant Lisp state has changed."
+  ;; FIXME: *slime-features* should be connection-local
+  (unless (eq *slime-features* *features*)
+    (setq *slime-features* *features*)
+    (send-to-emacs (list :new-features (features-for-emacs)))))
+
+(defun features-for-emacs ()
+  "Return `*slime-features*' in a format suitable to send it to Emacs."
+  *slime-features*)
+
+(add-hook *pre-reply-hook* 'sync-features-to-emacs)
+
+
+;;;;; Indentation of macros
+;;;
+;;; This code decides how macros should be indented (based on their
+;;; arglists) and tells Emacs. A per-connection cache is used to avoid
+;;; sending redundant information to Emacs -- we just say what's
+;;; changed since last time.
+;;;
+;;; The strategy is to scan all symbols, pick out the macros, and look
+;;; for &body-arguments.
+
+(defvar *configure-emacs-indentation* t
+  "When true, automatically send indentation information to Emacs
+after each command.")
+
+(defslimefun update-indentation-information ()
+  (perform-indentation-update *emacs-connection* t)
+  nil)
+
+;; This function is for *PRE-REPLY-HOOK*.
+(defun sync-indentation-to-emacs ()
+  "Send any indentation updates to Emacs via CONNECTION."
+  (when *configure-emacs-indentation*
+    (let ((fullp (need-full-indentation-update-p *emacs-connection*)))
+      (perform-indentation-update *emacs-connection* fullp))))
+
+(defun need-full-indentation-update-p (connection)
+  "Return true if the whole indentation cache should be updated.
+This is a heuristic to avoid scanning all symbols all the time:
+instead, we only do a full scan if the set of packages has changed."
+  (set-difference (list-all-packages)
+                  (connection.indentation-cache-packages connection)))
+
+(defun perform-indentation-update (connection force)
+  "Update the indentation cache in CONNECTION and update Emacs.
+If FORCE is true then start again without considering the old cache."
+  (let ((cache (connection.indentation-cache connection)))
+    (when force (clrhash cache))
+    (let ((delta (update-indentation/delta-for-emacs cache force)))
+      (setf (connection.indentation-cache-packages connection)
+            (list-all-packages))
+      (unless (null delta)
+        (send-to-emacs (list :indentation-update delta))))))
+
+(defun update-indentation/delta-for-emacs (cache &optional force)
+  "Update the cache and return the changes in a (SYMBOL . INDENT) list.
+If FORCE is true then check all symbols, otherwise only check symbols
+belonging to the buffer package."
+  (let ((alist '()))
+      (flet ((consider (symbol)
+             (let ((indent (symbol-indentation symbol)))
+               (when indent
+                 (unless (equal (gethash symbol cache) indent)
+                   (setf (gethash symbol cache) indent)
+                   (push (cons (string-downcase symbol) indent) alist))))))
+      (if force
+          (do-all-symbols (symbol)
+            (consider symbol))
+          (do-symbols (symbol *buffer-package*)
+            ;; We're really just interested in the symbols of *BUFFER-PACKAGE*,
+            ;; and *not* all symbols that are _present_ (cf. SYMBOL-STATUS.)
+            (when (eq (symbol-package symbol) *buffer-package*)
+              (consider symbol)))))
+    alist))
+
+(defun package-names (package)
+  "Return the name and all nicknames of PACKAGE in a fresh list."
+  (cons (package-name package) (copy-list (package-nicknames package))))
+
+(defun cl-symbol-p (symbol)
+  "Is SYMBOL a symbol in the COMMON-LISP package?"
+  (eq (symbol-package symbol) cl-package))
+
+(defun known-to-emacs-p (symbol)
+  "Return true if Emacs has special rules for indenting SYMBOL."
+  (cl-symbol-p symbol))
+
+(defun symbol-indentation (symbol)
+  "Return a form describing the indentation of SYMBOL.
+The form is to be used as the `common-lisp-indent-function' property
+in Emacs."
+  (if (and (macro-function symbol)
+           (not (known-to-emacs-p symbol)))
+      (let ((arglist (arglist symbol)))
+        (etypecase arglist
+          ((member :not-available)
+           nil)
+          (list
+           (macro-indentation arglist))))
+      nil))
+
+(defun macro-indentation (arglist)
+  (if (well-formed-list-p arglist)
+      (position '&body (remove '&optional (clean-arglist arglist)))
+      nil))
+
+(defun clean-arglist (arglist)
+  "Remove &whole, &enviroment, and &aux elements from ARGLIST."
+  (cond ((null arglist) '())
+        ((member (car arglist) '(&whole &environment))
+         (clean-arglist (cddr arglist)))
+        ((eq (car arglist) '&aux)
+         '())
+        (t (cons (car arglist) (clean-arglist (cdr arglist))))))
+
+(defun well-formed-list-p (list)
+  "Is LIST a proper list terminated by NIL?"
+  (typecase list
+    (null t)
+    (cons (well-formed-list-p (cdr list)))
+    (t    nil)))
+
+(defun print-indentation-lossage (&optional (stream *standard-output*))
+  "Return the list of symbols whose indentation styles collide incompatibly.
+Collisions are caused because package information is ignored."
+  (let ((table (make-hash-table :test 'equal)))
+    (flet ((name (s) (string-downcase (symbol-name s))))
+      (do-all-symbols (s)
+        (setf (gethash (name s) table)
+              (cons s (symbol-indentation s))))
+      (let ((collisions '()))
+        (do-all-symbols (s)
+          (let* ((entry (gethash (name s) table))
+                 (owner (car entry))
+                 (indent (cdr entry)))
+            (unless (or (eq s owner)
+                        (equal (symbol-indentation s) indent)
+                        (and (not (fboundp s))
+                             (null (macro-function s))))
+              (pushnew owner collisions)
+              (pushnew s collisions))))
+        (if (null collisions)
+            (format stream "~&No worries!~%")
+            (format stream "~&Symbols with collisions:~%~{  ~S~%~}"
+                    collisions))))))
+
+(add-hook *pre-reply-hook* 'sync-indentation-to-emacs)
+
+;;; swank.lisp ends here

Added: branches/trunk-reorg/thirdparty/slime/test-all.sh
===================================================================
--- branches/trunk-reorg/thirdparty/slime/test-all.sh	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/test-all.sh	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,14 @@
+#!/bin/sh
+
+# This code has been placed in the Public Domain.  All warranties
+# are disclaimed.
+
+trap EXIT
+
+for emacs in xemacs ; do # emacs-20.7 emacs-21.3.50 xemacs ; do
+  for lisp in 'cmucl -noinit' sbcl lispworks-personal-4300 'clisp -K full' acl5; do
+  echo testing: $emacs $lisp dribble.$emacs_$lisp result.$emacs_$lisp 
+  test.sh $emacs "$lisp" "dribble.${emacs}_${lisp}" "result.${emacs}_${lisp}"
+ done
+done
+    
\ No newline at end of file


Property changes on: branches/trunk-reorg/thirdparty/slime/test-all.sh
___________________________________________________________________
Name: svn:executable
   + *

Added: branches/trunk-reorg/thirdparty/slime/test.sh
===================================================================
--- branches/trunk-reorg/thirdparty/slime/test.sh	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/test.sh	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,82 @@
+#!/bin/sh
+
+# Run the SLIME test suite inside screen, saving the results to a file.
+
+# This script's exit status is the number of tests failed. If no tests
+# fail then no output is printed. If at least one test fails then a
+# one-line summary is printed.
+
+# If something unexpected fails, you might get an exit code like 127
+# or 255 instead. Sorry.
+
+# This code has been placed in the Public Domain.  All warranties
+# are disclaimed.
+
+function usage () {
+    echo "Usage: $name [-v] [-r] <emacs> <lisp>"
+    exit 1
+}
+
+name=$0
+
+while getopts vr opt; do
+    case $opt in
+	v) verbose=true;;
+	r) dump_results=true;;
+	*) usage;;
+    esac
+done
+
+shift $((OPTIND - 1))
+[ $# = 2 ] || usage
+
+emacs=$1; lisp=$2;
+
+# Move the code into a directory in /tmp, so that we can compile it
+# for the current lisp.
+
+slimedir=$(dirname $name)
+testdir=/tmp/slime-test.$$
+results=$testdir/results
+dribble=$testdir/dribble
+statusfile=$testdir/status
+
+test -d $testdir && rm -r $testdir
+
+trap "rm -r $testdir" EXIT	# remove temporary directory on exit
+
+mkdir $testdir
+cp -r $slimedir/*.{el,lisp} ChangeLog $slimedir/contrib  $testdir
+mkfifo $dribble
+
+session=slime-screen.$$
+
+screen -S $session -m -D bash -c "$emacs -nw -q -no-site-file --no-site-file \
+       --eval '(setq debug-on-quit t)' \
+       --eval '(setq max-lisp-eval-depth 1000)' \
+       --eval '(setq load-path (cons \"$testdir\" load-path))' \
+       --eval '(require (quote slime))' \
+       --eval '(setq inferior-lisp-program \"$lisp\")' \
+       --eval '(slime-batch-test \"$results\")' > $dribble;\
+       echo \$? > $statusfile" &
+
+screenpid=$!
+
+if [ "$verbose" = true ]; then
+    cat $dribble &
+else
+    cat $dribble > /dev/null &
+fi;
+
+trap "screen -S $session -X quit" SIGINT
+wait $screenpid
+
+if [ -f "$statusfile" ]; then
+    [ "$dump_results" = true ] && cat $results;
+    echo $(cat $statusfile) "test(s) failed."
+else
+    # Tests crashed
+    echo crashed
+fi
+
+exit $status


Property changes on: branches/trunk-reorg/thirdparty/slime/test.sh
___________________________________________________________________
Name: svn:executable
   + *

Added: branches/trunk-reorg/thirdparty/slime/xref.lisp
===================================================================
--- branches/trunk-reorg/thirdparty/slime/xref.lisp	2007-10-04 17:22:27 UTC (rev 2199)
+++ branches/trunk-reorg/thirdparty/slime/xref.lisp	2007-10-04 17:23:45 UTC (rev 2200)
@@ -0,0 +1,2891 @@
+;;; -*- Mode: LISP; Package: XREF; Syntax: Common-lisp;  -*- 
+;;; Mon Jan 21 16:21:20 1991 by Mark Kantrowitz <mkant at GLINDA.OZ.CS.CMU.EDU>
+;;; xref.lisp
+
+;;; ****************************************************************
+;;; List Callers: A Static Analysis Cross Referencing Tool for Lisp 
+;;; ****************************************************************
+;;; 
+;;; The List Callers system is a portable Common Lisp cross referencing
+;;; utility. It grovels over a set of files and compiles a database of the
+;;; locations of all references for each symbol used in the files.
+;;; List Callers is similar to the Symbolics Who-Calls and the
+;;; Xerox Masterscope facilities.
+;;;
+;;; When you change a function or variable definition, it can be useful
+;;; to know its callers, in order to update each of them to the new
+;;; definition. Similarly, having a graphic display of the structure 
+;;; (e.g., call graph) of a program can help make undocumented code more
+;;; understandable. This static code analyzer facilitates both capabilities.
+;;; The database compiled by xref is suitable for viewing by a graphical 
+;;; browser. (Note: the reference graph is not necessarily a DAG. Since many
+;;; graphical browsers assume a DAG, this will lead to infinite loops.
+;;; Some code which is useful in working around this problem is included,
+;;; as well as a sample text-indenting outliner and an interface to Bates'
+;;; PSGraph Postscript Graphing facility.) 
+;;;
+;;; Written by Mark Kantrowitz, July 1990.
+;;;
+;;; Address: School of Computer Science
+;;;          Carnegie Mellon University
+;;;          Pittsburgh, PA 15213
+;;;
+;;; Copyright (c) 1990. All rights reserved.
+;;;
+;;; See general license below.
+;;;
+
+;;; ****************************************************************
+;;; General License Agreement and Lack of Warranty *****************
+;;; ****************************************************************
+;;;
+;;; This software is distributed in the hope that it will be useful (both
+;;; in and of itself and as an example of lisp programming), but WITHOUT
+;;; ANY WARRANTY. The author(s) do not accept responsibility to anyone for
+;;; the consequences of using it or for whether it serves any particular
+;;; purpose or works at all. No warranty is made about the software or its
+;;; performance. 
+;;; 
+;;; Use and copying of this software and the preparation of derivative
+;;; works based on this software are permitted, so long as the following
+;;; conditions are met:
+;;; 	o  The copyright notice and this entire notice are included intact
+;;; 	   and prominently carried on all copies and supporting documentation.
+;;; 	o  No fees or compensation are charged for use, copies, or
+;;; 	   access to this software. You may charge a nominal
+;;; 	   distribution fee for the physical act of transferring a
+;;; 	   copy, but you may not charge for the program itself. 
+;;; 	o  If you modify this software, you must cause the modified
+;;; 	   file(s) to carry prominent notices (a Change Log)
+;;; 	   describing the changes, who made the changes, and the date
+;;; 	   of those changes.
+;;; 	o  Any work distributed or published that in whole or in part
+;;; 	   contains or is a derivative of this software or any part 
+;;; 	   thereof is subject to the terms of this agreement. The 
+;;; 	   aggregation of another unrelated program with this software
+;;; 	   or its derivative on a volume of storage or distribution
+;;; 	   medium does not bring the other program under the scope
+;;; 	   of these terms.
+;;; 	o  Permission is granted to manufacturers and distributors of
+;;; 	   lisp compilers and interpreters to include this software
+;;; 	   with their distribution. 
+;;; 
+;;; This software is made available AS IS, and is distributed without 
+;;; warranty of any kind, either expressed or implied.
+;;; 
+;;; In no event will the author(s) or their institutions be liable to you
+;;; for damages, including lost profits, lost monies, or other special,
+;;; incidental or consequential damages arising out of or in connection
+;;; with the use or inability to use (including but not limited to loss of
+;;; data or data being rendered inaccurate or losses sustained by third
+;;; parties or a failure of the program to operate as documented) the 
+;;; program, even if you have been advised of the possibility of such
+;;; damanges, or for any claim by any other party, whether in an action of
+;;; contract, negligence, or other tortious action.
+;;; 
+;;; The current version of this software and a variety of related utilities
+;;; may be obtained by anonymous ftp from ftp.cs.cmu.edu in the directory
+;;;    user/ai/lang/lisp/code/tools/xref/
+;;; 
+;;; Please send bug reports, comments, questions and suggestions to
+;;; mkant at cs.cmu.edu. We would also appreciate receiving any changes
+;;; or improvements you may make. 
+;;; 
+;;; If you wish to be added to the Lisp-Utilities at cs.cmu.edu mailing list, 
+;;; send email to Lisp-Utilities-Request at cs.cmu.edu with your name, email
+;;; address, and affiliation. This mailing list is primarily for
+;;; notification about major updates, bug fixes, and additions to the lisp
+;;; utilities collection. The mailing list is intended to have low traffic.
+;;;
+
+;;; ********************************
+;;; Change Log *********************
+;;; ********************************
+;;;
+;;; 27-FEB-91 mk   Added insert arg to psgraph-xref to allow the postscript
+;;;                graphs to be inserted in Scribe documents.
+;;; 21-FEB-91 mk   Added warning if not compiled.
+;;; 07-FEB-91 mk   Fixed bug in record-callers with regard to forms at 
+;;;                toplevel.
+;;; 21-JAN-91 mk   Added file xref-test.lisp to test xref.
+;;; 16-JAN-91 mk   Added definition WHO-CALLS to parallel the Symbolics syntax.
+;;; 16-JAN-91 mk   Added macroexpansion capability to record-callers. Also
+;;;                added parameter *handle-macro-forms*, defaulting to T.
+;;; 16-JAN-91 mk   Modified print-caller-tree and related functions
+;;;                to allow the user to specify root nodes. If the user
+;;;                doesn't specify them, it will default to all root
+;;;                nodes, as before. 
+;;; 16-JAN-91 mk   Added parameter *default-graphing-mode* to specify
+;;;                the direction of the graphing. Either :call-graph,
+;;;                where the children of a node are those functions called
+;;;                by the node, or :caller-graph where the children of a
+;;;                node are the callers of the node. :call-graph is the
+;;;                default.
+;;; 16-JAN-91 mk   Added parameter *indent-amount* to control the indentation
+;;;                in print-indented-tree.
+;;; 16-JUL-90 mk   Functions with argument lists of () were being ignored
+;;;                because of a (when form) wrapped around the body of
+;;;                record-callers. Then intent of (when form) was as an extra
+;;;                safeguard against infinite looping. This wasn't really
+;;;                necessary, so it has been removed.
+;;; 16-JUL-90 mk   PSGraph-XREF now has keyword arguments, instead of
+;;;                optionals.
+;;; 16-JUL-90 mk   Added PRINT-CLASS-HIERARCHY to use psgraph to graph the
+;;;                CLOS class hierarchy. This really doesn't belong here,
+;;;                and should be moved to psgraph.lisp as an example of how
+;;;                to use psgraph.
+;;; 16-JUL-90 mk   Fixed several caller patterns. The pattern for member
+;;;                had an error which caused many references to be missed.
+;;; 16-JUL-90 mk   Added ability to save/load processed databases.
+;;;  5-JUL-91 mk    Fixed warning of needing compilation to occur only when the
+;;;                 source is loaded.
+;;; 20-SEP-93 mk    Added fix from Peter Norvig to allow Xref to xref itself.
+;;;                 The arg to macro-function must be a symbol.
+
+;;; ********************************
+;;; To Do **************************
+;;; ********************************
+;;;
+;;; Verify that:
+;;;    o  null forms don't cause it to infinite loop.
+;;;    o  nil matches against null argument lists.
+;;;    o  declarations and doc are being ignored.
+;;;
+;;; Would be nice if in addition to showing callers of a function, it
+;;; displayed the context of the calls to the function (e.g., the
+;;; immediately surrounding form). This entails storing entries of
+;;; the form (symbol context*) in the database and augmenting
+;;; record-callers to keep the context around. The only drawbacks is
+;;; that it would cons a fair bit. If we do this, we should store
+;;; additional information as well in the database, such as the caller
+;;; pattern type (e.g., variable vs. function).
+;;;
+;;; Write a translator from BNF (at least as much of BNF as is used
+;;; in CLtL2), to the format used here.
+;;;
+;;; Should automatically add new patterns for new functions and macros
+;;; based on their arglists. Probably requires much more than this
+;;; simple code walker, so there isn't much we can do.
+;;;
+;;; Defmacro is a problem, because it often hides internal function
+;;; calls within backquote and quote, which we normally ignore. If
+;;; we redefine QUOTE's pattern so that it treats the arg like a FORM,
+;;; we'll probably get them (though maybe the syntax will be mangled),
+;;; but most likely a lot of spurious things as well. 
+;;;
+;;; Define an operation for Defsystem which will run XREF-FILE on the
+;;; files of the system. Or yet simpler, when XREF sees a LOAD form
+;;; for which the argument is a string, tries to recursively call
+;;; XREF-FILE on the specified file. Then one could just XREF-FILE
+;;; the file which loads the system. (This should be a program
+;;; parameter.)
+;;;
+;;; Have special keywords which the user may place in a file to have
+;;; XREF-FILE ignore a region.
+;;;
+;;; Should we distinguish flet and labels from defun? I.e., note that
+;;; flet's definitions are locally defined, instead of just lumping
+;;; them in with regular definitions.
+;;;
+;;; Add patterns for series, loop macro.
+;;;
+;;; Need to integrate the variable reference database with the other
+;;; databases, yet maintain separation. So we can distinguish all
+;;; the different types of variable and function references, without
+;;; multiplying databases.
+;;;
+;;; Would pay to comment record-callers and record-callers* in more
+;;; depth.
+;;; 
+;;; (&OPTIONAL &REST &KEY &AUX &BODY &WHOLE &ALLOW-OTHER-KEYS &ENVIRONMENT)
+
+;;; ********************************
+;;; Notes **************************
+;;; ********************************
+;;;
+;;;    XREF has been tested (successfully) in the following lisps:
+;;;       CMU Common Lisp (M2.9 15-Aug-90, Compiler M1.8 15-Aug-90)
+;;;       Macintosh Allegro Common Lisp (1.3.2)
+;;;       ExCL (Franz Allegro CL 3.1.12 [DEC 3100] 3/30/90)
+;;;       Lucid CL (Version 2.1 6-DEC-87)
+;;;    
+;;;    XREF has been tested (unsuccessfully) in the following lisps:
+;;;       Ibuki Common Lisp (01/01, October 15, 1987)
+;;;           - if interpreted, runs into stack overflow
+;;;           - does not compile (tried ibcl on Suns, PMAXes and RTs)
+;;;             seems to be due to a limitation in the c compiler.
+;;;    
+;;;    XREF needs to be tested in the following lisps:
+;;;       Symbolics Common Lisp (8.0)
+;;;       Lucid Common Lisp (3.0, 4.0)
+;;;       KCL (June 3, 1987 or later)
+;;;       AKCL (1.86, June 30, 1987 or later)
+;;;       TI (Release 4.1 or later)
+;;;       Golden Common Lisp (3.1 IBM-PC)
+;;;       VAXLisp (2.0, 3.1)
+;;;       HP Common Lisp (same as Lucid?)
+;;;       Procyon Common Lisp
+
+
+;;; ****************************************************************
+;;; Documentation **************************************************
+;;; ****************************************************************
+;;;
+;;; XREF analyzes a user's program, determining which functions call a
+;;; given function, and the location of where variables are bound/assigned
+;;; and used. The user may retrieve this information for either a single
+;;; symbol, or display the call graph of portions of the program
+;;; (including the entire program). This allows the programmer to debug
+;;; and document the program's structure.
+;;; 
+;;; XREF is primarily intended for analyzing large programs, where it is
+;;; difficult, if not impossible, for the programmer to grasp the structure
+;;; of the whole program. Nothing precludes using XREF for smaller programs,
+;;; where it can be useful for inspecting the relationships between pieces
+;;; of the program and for documenting the program.
+;;; 
+;;; Two aspects of the Lisp programming language greatly simplify the
+;;; analysis of Lisp programs:
+;;; 	o  Lisp programs are naturally represented as data.
+;;; 	   Successive definitions from a file are easily read in
+;;; 	   as list structure.
+;;; 	o  The basic syntax of Lisp is uniform. A list program
+;;; 	   consists of a set of nested forms, where each form is
+;;; 	   a list whose car is a tag (e.g., function name) that
+;;; 	   specifies the structure of the rest of the form.
+;;; Thus Lisp programs, when represented as data, can be considered to be
+;;; parse trees. Given a grammar of syntax patterns for the language, XREF
+;;; recursively descends the parse tree for a given definition, computing
+;;; a set of relations that hold for the definition at each node in the
+;;; tree. For example, one kind of relation is that the function defined
+;;; by the definition calls the functions in its body. The relations are
+;;; stored in a database for later examination by the user.
+;;; 
+;;; While XREF currently only works for programs written in Lisp, it could
+;;; be extended to other programming languages by writing a function to
+;;; generate parse trees for definitions in that language, and a core
+;;; set of patterns for the language's syntax.
+;;; 
+;;; Since XREF normally does a static syntactic analysis of the program, 
+;;; it does not detect references due to the expansion of a macro definition. 
+;;; To do this in full generality XREF would have to have knowledge about the
+;;; semantics of the program (e.g., macros which call other functions to
+;;; do the expansion). This entails either modifying the compiler to
+;;; record the relationships (e.g., Symbolics Who-Calls Database) or doing
+;;; a walk of loaded code and macroexpanding as needed (PCL code walker).
+;;; The former is not portable, while the latter requires that the code
+;;; used by macros be loaded and in working order. On the other hand, then
+;;; we would need no special knowledge about macros (excluding the 24 special
+;;; forms of Lisp).
+;;;
+;;; Parameters may be set to enable macro expansion in XREF. Then XREF
+;;; will expand any macros for which it does not have predefined patterns.
+;;; (For example, most Lisps will implement dolist as a macro. Since XREF
+;;; has a pattern defined for dolist, it will not call macroexpand-1 on
+;;; a form whose car is dolist.) For this to work properly, the code must
+;;; be loaded before being processed by XREF, and XREF's parameters should
+;;; be set so that it processes forms in their proper packages. 
+;;;
+;;; If macro expansion is disabled, the default rules for handling macro
+;;; references may not be sufficient for some user-defined macros, because
+;;; macros allow a variety of non-standard syntactic extensions to the
+;;; language. In this case, the user may specify additional templates in
+;;; a manner similar to that in which the core Lisp grammar was specified.
+;;;
+
+
+;;; ********************************
+;;; User Guide *********************
+;;; ********************************
+;;; -----
+;;; The following functions are called to cross reference the source files.
+;;;
+;;; XREF-FILES (&rest files)                                      [FUNCTION]
+;;;    Grovels over the lisp code located in source file FILES, using
+;;;    xref-file.
+;;;
+;;; XREF-FILE (filename &optional clear-tables verbose)       [Function]
+;;;    Cross references the function and variable calls in FILENAME by
+;;;    walking over the source code located in the file. Defaults type of
+;;;    filename to ".lisp". Chomps on the code using record-callers and
+;;;    record-callers*. If CLEAR-TABLES is T (the default), it clears the
+;;;    callers database before processing the file. Specify CLEAR-TABLES as
+;;;    nil to append to the database. If VERBOSE is T (the default), prints
+;;;    out the name of the file, one progress dot for each form processed,
+;;;    and the total number of forms.
+;;;
+;;; -----
+;;; The following functions display information about the uses of the 
+;;; specified symbol as a function, variable, or constant.
+;;;
+;;; LIST-CALLERS (symbol)                                         [FUNCTION]
+;;;    Lists all functions which call SYMBOL as a function (function
+;;;    invocation).
+;;;
+;;; LIST-READERS (symbol)                                         [FUNCTION]
+;;;    Lists all functions which refer to SYMBOL as a variable
+;;;    (variable reference).
+;;;
+;;; LIST-SETTERS (symbol)                                         [FUNCTION]
+;;;    Lists all functions which bind/set SYMBOL as a variable
+;;;    (variable mutation).
+;;;
+;;; LIST-USERS (symbol)                                           [FUNCTION]
+;;;    Lists all functions which use SYMBOL as a variable or function.
+;;;
+;;; WHO-CALLS (symbol &optional how)                              [FUNCTION]
+;;;    Lists callers of symbol. HOW may be :function, :reader, :setter,
+;;;    or :variable."
+;;;
+;;; WHAT-FILES-CALL (symbol)                                      [FUNCTION]
+;;;    Lists names of files that contain uses of SYMBOL
+;;;    as a function, variable, or constant.
+;;;
+;;; SOURCE-FILE (symbol)                                          [FUNCTION]
+;;;    Lists the names of files in which SYMBOL is defined/used.
+;;;
+;;; LIST-CALLEES (symbol)                                         [FUNCTION]
+;;;    Lists names of functions and variables called by SYMBOL.
+;;;
+;;; -----
+;;; The following functions may be useful for viewing the database and
+;;; debugging the calling patterns.
+;;;
+;;; *LAST-FORM* ()                                                [VARIABLE]
+;;;    The last form read from the file. Useful for figuring out what went
+;;;    wrong when xref-file drops into the debugger.
+;;;
+;;; *XREF-VERBOSE* t                                              [VARIABLE]
+;;;    When T, xref-file(s) prints out the names of the files it looks at,
+;;;    progress dots, and the number of forms read.
+;;;
+;;; *TYPES-TO-IGNORE* (quote (:lisp :lisp2))                      [VARIABLE]
+;;;    Default set of caller types (as specified in the patterns) to ignore
+;;;    in the database handling functions. :lisp is CLtL 1st edition,
+;;;    :lisp2 is additional patterns from CLtL 2nd edition.
+;;;
+;;; *HANDLE-PACKAGE-FORMS* ()                                     [VARIABLE]
+;;;    When non-NIL, and XREF-FILE sees a package-setting form like
+;;;    IN-PACKAGE, sets the current package to the specified package by
+;;;    evaluating the form. When done with the file, xref-file resets the
+;;;    package to its original value. In some of the displaying functions,
+;;;    when this variable is non-NIL one may specify that all symbols from a
+;;;    particular set of packages be ignored. This is only useful if the
+;;;    files use different packages with conflicting names.
+;;;
+;;; *HANDLE-FUNCTION-FORMS* t                                     [VARIABLE]
+;;;    When T, XREF-FILE tries to be smart about forms which occur in
+;;;    a function position, such as lambdas and arbitrary Lisp forms.
+;;;    If so, it recursively calls record-callers with pattern 'FORM.
+;;;    If the form is a lambda, makes the caller a caller of
+;;;    :unnamed-lambda.
+;;;
+;;; *HANDLE-MACRO-FORMS* t                                        [VARIABLE]
+;;;    When T, if the file was loaded before being processed by XREF, and
+;;;    the car of a form is a macro, it notes that the parent calls the
+;;;    macro, and then calls macroexpand-1 on the form.
+;;;
+;;; *DEFAULT-GRAPHING-MODE* :call-graph                           [VARIABLE]
+;;;    Specifies whether we graph up or down. If :call-graph, the children
+;;;    of a node are the functions it calls. If :caller-graph, the
+;;;    children of a node are the functions that call it.
+;;;
+;;; *INDENT-AMOUNT* 3                                             [VARIABLE]
+;;;    Number of spaces to indent successive levels in PRINT-INDENTED-TREE.
+;;;
+;;; DISPLAY-DATABASE (&optional database types-to-ignore)         [FUNCTION]
+;;;    Prints out the name of each symbol and all its callers. Specify
+;;;    database :callers (the default) to get function call references,
+;;;    :file to the get files in which the symbol is called, :readers to get
+;;;    variable references, and :setters to get variable binding and
+;;;    assignments. Ignores functions of types listed in types-to-ignore.
+;;;
+;;; PRINT-CALLER-TREES (&key (mode *default-graphing-mode*)       [FUNCTION]
+;;;                     (types-to-ignore *types-to-ignore*)
+;;;                     compact root-nodes)
+;;;    Prints the calling trees (which may actually be a full graph and not
+;;;    necessarily a DAG) as indented text trees using
+;;;    PRINT-INDENTED-TREE. MODE is :call-graph for trees where the children
+;;;    of a node are the functions called by the node, or :caller-graph for
+;;;    trees where the children of a node are the functions the node calls.
+;;;    TYPES-TO-IGNORE is a list of funcall types (as specified in the
+;;;    patterns) to ignore in printing out the database. For example,
+;;;    '(:lisp) would ignore all calls to common lisp functions. COMPACT is
+;;;    a flag to tell the program to try to compact the trees a bit by not
+;;;    printing trees if they have already been seen. ROOT-NODES is a list
+;;;    of root nodes of trees to display. If ROOT-NODES is nil, tries to
+;;;    find all root nodes in the database.
+;;;
+;;; MAKE-CALLER-TREE (&optional (mode *default-graphing-mode*)    [FUNCTION]
+;;;                   (types-to-ignore *types-to-ignore*)
+;;;                   compact)
+;;;    Outputs list structure of a tree which roughly represents the
+;;;    possibly cyclical structure of the caller database.
+;;;    If mode is :call-graph, the children of a node are the functions
+;;;    it calls. If mode is :caller-graph, the children of a node are the
+;;;    functions that call it.
+;;;    If compact is T, tries to eliminate the already-seen nodes, so
+;;;    that the graph for a node is printed at most once. Otherwise it will
+;;;    duplicate the node's tree (except for cycles). This is usefull
+;;;    because the call tree is actually a directed graph, so we can either
+;;;    duplicate references or display only the first one.
+;;;
+;;; DETERMINE-FILE-DEPENDENCIES (&optional database)          [FUNCTION]
+;;;    Makes a hash table of file dependencies for the references listed in
+;;;    DATABASE. This function may be useful for automatically resolving
+;;;    file references for automatic creation of a system definition
+;;;    (defsystem).
+;;;
+;;; PRINT-FILE-DEPENDENCIES (&optional database)              [FUNCTION]
+;;;    Prints a list of file dependencies for the references listed in
+;;;    DATABASE. This function may be useful for automatically computing
+;;;    file loading constraints for a system definition tool.
+;;;
+;;; WRITE-CALLERS-DATABASE-TO-FILE (filename)                     [FUNCTION]
+;;;    Saves the contents of the current callers database to a file. This
+;;;    file can be loaded to restore the previous contents of the
+;;;    database. (For large systems it can take a long time to crunch
+;;;    through the code, so this can save some time.)
+;;;
+;;; -----
+;;; The following macros define new function and macro call patterns.
+;;; They may be used to extend the static analysis tool to handle
+;;; new def forms, extensions to Common Lisp, and program defs.
+;;;
+;;; DEFINE-PATTERN-SUBSTITUTION (name pattern)                    [MACRO]
+;;;    Defines NAME to be equivalent to the specified pattern. Useful for
+;;;    making patterns more readable. For example, the LAMBDA-LIST is
+;;;    defined as a pattern substitution, making the definition of the
+;;;    DEFUN caller-pattern simpler.
+;;;
+;;; DEFINE-CALLER-PATTERN (name pattern &optional caller-type)    [MACRO]
+;;;    Defines NAME as a function/macro call with argument structure
+;;;    described by PATTERN. CALLER-TYPE, if specified, assigns a type to
+;;;    the pattern, which may be used to exclude references to NAME while
+;;;    viewing the database. For example, all the Common Lisp definitions
+;;;    have a caller-type of :lisp or :lisp2, so that you can exclude
+;;;    references to common lisp functions from the calling tree.
+;;;
+;;; DEFINE-VARIABLE-PATTERN (name &optional caller-type)          [MACRO]
+;;;    Defines NAME as a variable reference of type CALLER-TYPE. This is
+;;;    mainly used to establish the caller-type of the variable.
+;;;
+;;; DEFINE-CALLER-PATTERN-SYNONYMS (source destinations)          [MACRO]
+;;;    For defining function caller pattern syntax synonyms. For each name
+;;;    in DESTINATIONS, defines its pattern as a copy of the definition
+;;;    of SOURCE. Allows a large number of identical patterns to be defined
+;;;    simultaneously. Must occur after the SOURCE has been defined.
+;;;
+;;; -----
+;;; This system includes pattern definitions for the latest
+;;; common lisp specification, as published in Guy Steele,
+;;; Common Lisp: The Language, 2nd Edition.
+;;;
+;;; Patterns may be either structures to match, or a predicate
+;;; like symbolp/numberp/stringp. The pattern specification language
+;;; is similar to the notation used in CLtL2, but in a more lisp-like 
+;;; form:
+;;;    (:eq name)           The form element must be eq to the symbol NAME.
+;;;    (:test test)         TEST must be true when applied to the form element.
+;;;    (:typep type)        The form element must be of type TYPE.
+;;;    (:or pat1 pat2 ...)  Tries each of the patterns in left-to-right order,
+;;;                         until one succeeds.
+;;;                         Equivalent to { pat1 | pat2 | ... }
+;;;    (:rest pattern)      The remaining form elements are grouped into a
+;;;                         list which is matched against PATTERN.
+;;;    (:optional pat1 ...) The patterns may optionally match against the
+;;;                         form element.
+;;;                         Equivalent to [ pat1 ... ].
+;;;    (:star pat1 ...)     The patterns may match against the patterns
+;;;                         any number of times, including 0.
+;;;                         Equivalent to { pat1 ... }*.
+;;;    (:plus pat1 ...)     The patterns may match against the patterns
+;;;                         any number of times, but at least once.
+;;;                         Equivalent to { pat1 ... }+.
+;;;    &optional, &key,     Similar in behavior to the corresponding
+;;;    &rest                lambda-list keywords.
+;;;    FORM                 A random lisp form. If a cons, assumes the
+;;;                         car is a function or macro and tries to
+;;;                         match the args against that symbol's pattern.
+;;;                         If a symbol, assumes it's a variable reference.
+;;;    :ignore              Ignores the corresponding form element.
+;;;    NAME                 The corresponding form element should be
+;;;                         the name of a new definition (e.g., the
+;;;                         first arg in a defun pattern is NAME.
+;;;    FUNCTION, MACRO      The corresponding form element should be
+;;;                         a function reference not handled by FORM.
+;;;                         Used in the definition of apply and funcall.
+;;;    VAR                  The corresponding form element should be
+;;;                         a variable definition or mutation. Used
+;;;                         in the definition of let, let*, etc.
+;;;    VARIABLE             The corresponding form element should be
+;;;                         a variable reference. 
+;;;
+;;; In all other pattern symbols, it looks up the symbols pattern substitution
+;;; and recursively matches against the pattern. Automatically destructures
+;;; list structure that does not include consing dots.
+;;;
+;;; Among the pattern substitution names defined are:
+;;;    STRING, SYMBOL, NUMBER    Appropriate :test patterns.
+;;;    LAMBDA-LIST               Matches against a lambda list.
+;;;    BODY                      Matches against a function body definition.
+;;;    FN                        Matches against #'function, 'function,
+;;;                              and lambdas. This is used in the definition
+;;;                              of apply, funcall, and the mapping patterns.
+;;;    and others...
+;;;
+;;; Here's some sample pattern definitions:
+;;; (define-caller-pattern defun 
+;;;   (name lambda-list
+;;;	(:star (:or documentation-string declaration))
+;;;	(:star form))
+;;;  :lisp)
+;;; (define-caller-pattern funcall (fn (:star form)) :lisp)
+;;;
+;;; In general, the system is intelligent enough to handle any sort of
+;;; simple funcall. One only need specify the syntax for functions and
+;;; macros which use optional arguments, keyword arguments, or some
+;;; argument positions are special, such as in apply and funcall, or
+;;; to indicate that the function is of the specified caller type.
+;;;
+;;;
+;;; NOTES:
+;;;
+;;;    XRef assumes syntactically correct lisp code.
+;;;
+;;;    This is by no means perfect. For example, let and let* are treated
+;;;    identically, instead of differentiating between serial and parallel
+;;;    binding. But it's still a useful tool. It can be helpful in 
+;;;    maintaining code, debugging problems with patch files, determining
+;;;    whether functions are multiply defined, and help you remember where
+;;;    a function is defined or called.
+;;;
+;;;    XREF runs best when compiled.
+
+;;; ********************************
+;;; References *********************
+;;; ********************************
+;;;
+;;; Xerox Interlisp Masterscope Program:
+;;;   Larry M Masinter, Global program analysis in an interactive environment
+;;;   PhD Thesis, Stanford University, 1980. 
+;;;
+;;; Symbolics Who-Calls Database:
+;;;   User's Guide to Symbolics Computers, Volume 1, Cambridge, MA, July 1986
+;;;   Genera 7.0, pp 183-185.
+;;;   
+
+;;; ********************************
+;;; Example ************************
+;;; ********************************
+;;; 
+;;; Here is an example of running XREF on a short program.
+;;; [In Scribe documentation, give a simple short program and resulting
+;;;  XREF output, including postscript call graphs.]
+#|
+<cl> (xref:xref-file  "/afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp")
+Cross-referencing file /afs/cs/user/mkant/Lisp/Graph-Dag/graph-dag.lisp.
+................................................
+48 forms processed.
+<cl> (xref:display-database :readers)
+
+*DISPLAY-CUTOFF-DEPTH* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
+*OFFSET-FROM-EDGE-OF-PANE* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE.
+*WITHIN-LEVEL-SPACING* is referenced by BREADTH CALCULATE-POSITION-INFO.
+*DIRECTION* is referenced by CREATE-POSITION-INFO.
+*LINK-OFFSET* is referenced by OFFSET-OF-LINK-FROM-ATTACHMENT-POINT.
+*ROOT-IS-SEQUENCE* is referenced by GRAPH.
+*LEVEL-SPACING* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE.
+*ORIENTATION* is referenced by BREADTH CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CALCULATE-POSITION-IN-LEVEL.
+*DEFAULT-GRAPH-POSITION* is referenced by CREATE-POSITION-INFO.
+*GRAPHING-CUTOFF-DEPTH* is referenced by CREATE-NODE-STRUCTURE.
+*LIST-OF-NODES* is referenced by CALCULATE-LEVEL-POSITION CALCULATE-LEVEL-POSITION-BEFORE CREATE-NODE FIND-NODE.
+*GRAPH-TYPE* is referenced by CREATE-NODE-STRUCTURE.
+<cl> (xref:print-caller-trees :root-nodes '(display-graph))
+
+Rooted calling trees:
+  DISPLAY-GRAPH
+     CREATE-POSITION-INFO
+        CALCULATE-POSITION-INFO
+           CALCULATE-POSITION
+              NODE-POSITION-ALREADY-SET-FLAG
+              NODE-LEVEL-ALREADY-SET-FLAG
+              CALCULATE-POSITION-IN-LEVEL
+                 NODE-CHILDREN
+                 NODE-LEVEL
+                 CALCULATE-POSITION
+                 NEW-CALCULATE-BREADTH
+                    NODE-CHILDREN
+                    BREADTH
+                       OPPOSITE-DIMENSION
+                          NODE-HEIGHT
+                          NODE-WIDTH
+                    NEW-CALCULATE-BREADTH
+                    NODE-PARENTS
+                 OPPOSITE-DIMENSION
+                    NODE-HEIGHT
+                    NODE-WIDTH
+                 OPPOSITE-POSITION
+                    NODE-Y
+                    NODE-X
+        NODE-LEVEL
+        CALCULATE-LEVEL-POSITION
+           NODE-LEVEL
+           NODE-POSITION
+              NODE-X
+              NODE-Y
+           DIMENSION
+              NODE-WIDTH
+              NODE-HEIGHT
+        CALCULATE-LEVEL-POSITION-BEFORE
+           NODE-LEVEL
+           NODE-POSITION
+              NODE-X
+              NODE-Y
+           NODE-WIDTH
+           NODE-HEIGHT
+           DIMENSION
+              NODE-WIDTH
+              NODE-HEIGHT
+|#
+
+;;; ****************************************************************
+;;; List Callers ***************************************************
+;;; ****************************************************************
+
+(defpackage :pxref
+  (:use :common-lisp)
+  (:export #:list-callers 
+	   #:list-users 
+	   #:list-readers 
+	   #:list-setters
+	   #:what-files-call
+	   #:who-calls 
+	   #:list-callees 
+	   #:source-file 
+	   #:clear-tables
+	   #:define-pattern-substitution 
+	   #:define-caller-pattern 
+	   #:define-variable-pattern 
+	   #:define-caller-pattern-synonyms
+	   #:clear-patterns
+	   #:*last-form* 
+	   #:*xref-verbose* 
+	   #:*handle-package-forms* 
+	   #:*handle-function-forms*
+	   #:*handle-macro-forms*
+	   #:*types-to-ignore*
+	   #:*last-caller-tree* 
+	   #:*default-graphing-mode* 
+	   #:*indent-amount*
+	   #:xref-file 
+	   #:xref-files
+	   #:write-callers-database-to-file
+	   #:display-database
+	   #:print-caller-trees 
+	   #:make-caller-tree 
+	   #:print-indented-tree 
+	   #:determine-file-dependencies 
+	   #:print-file-dependencies
+	   #:psgraph-xref
+	   ))
+
+(in-package "PXREF")
+
+;;; Warn user if they're loading the source instead of compiling it first.
+;(eval-when (compile load eval)
+;  (defvar compiled-p nil))
+;(eval-when (compile load)
+;  (setq compiled-p t))
+;(eval-when (load eval)
+;  (unless compiled-p
+;    (warn "This file should be compiled before loading for best results.")))
+(eval-when (eval)
+   (warn "This file should be compiled before loading for best results."))
+
+
+;;; ********************************
+;;; Primitives *********************
+;;; ********************************
+(defun lookup (symbol environment)
+  (dolist (frame environment)
+    (when (member symbol frame)
+      (return symbol))))
+
+(defun car-eq (list item)
+  (and (consp list)
+       (eq (car list) item)))
+
+;;; ********************************
+;;; Callers Database ***************
+;;; ********************************
+(defvar *file-callers-database* (make-hash-table :test #'equal)
+  "Contains name and list of file callers (files which call) for that name.")
+(defvar *callers-database* (make-hash-table :test #'equal)
+  "Contains name and list of callers (function invocation) for that name.")
+(defvar *readers-database* (make-hash-table :test #'equal)
+  "Contains name and list of readers (variable use) for that name.")
+(defvar *setters-database* (make-hash-table :test #'equal)
+  "Contains name and list of setters (variable mutation) for that name.")
+(defvar *callees-database* (make-hash-table :test #'equal)
+  "Contains name and list of functions and variables it calls.")
+(defun callers-list (name &optional (database :callers))
+  (case database
+    (:file    (gethash name *file-callers-database*))
+    (:callees (gethash name *callees-database*))
+    (:callers (gethash name *callers-database*))
+    (:readers (gethash name *readers-database*))
+    (:setters (gethash name *setters-database*))))
+(defsetf callers-list (name &optional (database :callers)) (caller)
+  `(setf (gethash ,name (case ,database
+			  (:file    *file-callers-database*)
+			  (:callees *callees-database*)
+			  (:callers *callers-database*)
+			  (:readers *readers-database*)
+			  (:setters *setters-database*)))
+	 ,caller))
+
+(defun list-callers (symbol)
+  "Lists all functions which call SYMBOL as a function (function invocation)."
+  (callers-list symbol :callers))
+(defun list-readers (symbol)
+  "Lists all functions which refer to SYMBOL as a variable 
+   (variable reference)."
+  (callers-list symbol :readers))
+(defun list-setters (symbol)
+  "Lists all functions which bind/set SYMBOL as a variable 
+   (variable mutation)."
+  (callers-list symbol :setters))
+(defun list-users (symbol)
+  "Lists all functions which use SYMBOL as a variable or function."
+  (values (list-callers symbol)
+	  (list-readers symbol)
+	  (list-setters symbol)))
+(defun who-calls (symbol &optional how)
+  "Lists callers of symbol. HOW may be :function, :reader, :setter,
+   or :variable."
+  ;; would be nice to have :macro and distinguish variable
+  ;; binding from assignment. (i.e., variable binding, assignment, and use)
+  (case how
+    (:function (list-callers symbol))
+    (:reader   (list-readers symbol))
+    (:setter   (list-setters symbol))
+    (:variable (append (list-readers symbol) 
+		       (list-setters symbol)))
+    (otherwise (append (list-callers symbol)
+		       (list-readers symbol)
+		       (list-setters symbol)))))
+(defun what-files-call (symbol)
+  "Lists names of files that contain uses of SYMBOL 
+   as a function, variable, or constant."
+  (callers-list symbol :file))
+(defun list-callees (symbol)
+  "Lists names of functions and variables called by SYMBOL."
+  (callers-list symbol :callees))
+
+(defvar *source-file* (make-hash-table :test #'equal)
+  "Contains function name and source file for that name.")
+(defun source-file (symbol)
+  "Lists the names of files in which SYMBOL is defined/used."
+  (gethash symbol *source-file*))
+(defsetf source-file (name) (value)
+  `(setf (gethash ,name *source-file*) ,value))
+
+(defun clear-tables ()
+  (clrhash *file-callers-database*)
+  (clrhash *callers-database*)
+  (clrhash *callees-database*)
+  (clrhash *readers-database*)
+  (clrhash *setters-database*)
+  (clrhash *source-file*))
+
+
+;;; ********************************
+;;; Pattern Database ***************
+;;; ********************************
+;;; Pattern Types
+(defvar *pattern-caller-type* (make-hash-table :test #'equal))
+(defun pattern-caller-type (name)
+  (gethash name *pattern-caller-type*))
+(defsetf pattern-caller-type (name) (value)
+  `(setf (gethash ,name *pattern-caller-type*) ,value))
+
+;;; Pattern Substitutions
+(defvar *pattern-substitution-table* (make-hash-table :test #'equal)
+  "Stores general patterns for function destructuring.")
+(defun lookup-pattern-substitution (name)
+  (gethash name *pattern-substitution-table*))
+(defmacro define-pattern-substitution (name pattern)
+  "Defines NAME to be equivalent to the specified pattern. Useful for
+   making patterns more readable. For example, the LAMBDA-LIST is 
+   defined as a pattern substitution, making the definition of the
+   DEFUN caller-pattern simpler."
+  `(setf (gethash ',name *pattern-substitution-table*)
+	 ',pattern))
+
+;;; Function/Macro caller patterns: 
+;;; The car of the form is skipped, so we don't need to specify
+;;; (:eq function-name) like we would for a substitution.
+;;;
+;;; Patterns must be defined in the XREF package because the pattern
+;;; language is tested by comparing symbols (using #'equal) and not
+;;; their printreps. This is fine for the lisp grammer, because the XREF
+;;; package depends on the LISP package, so a symbol like 'xref::cons is
+;;; translated automatically into 'lisp::cons. However, since
+;;; (equal 'foo::bar 'baz::bar) returns nil unless both 'foo::bar and
+;;; 'baz::bar are inherited from the same package (e.g., LISP), 
+;;; if package handling is turned on the user must specify package 
+;;; names in the caller pattern definitions for functions that occur
+;;; in packages other than LISP, otherwise the symbols will not match.
+;;; 
+;;; Perhaps we should enforce the definition of caller patterns in the
+;;; XREF package by wrapping the body of define-caller-pattern in
+;;; the XREF package:
+;;;    (defmacro define-caller-pattern (name value &optional caller-type)
+;;;      (let ((old-package *package*))
+;;;        (setf *package* (find-package "XREF"))
+;;;        (prog1
+;;;    	     `(progn
+;;;    	        (when ',caller-type
+;;;         	     (setf (pattern-caller-type ',name) ',caller-type))
+;;;    	        (when ',value 
+;;;    	          (setf (gethash ',name *caller-pattern-table*)
+;;;    		        ',value)))
+;;;          (setf *package* old-package)))) 
+;;; Either that, or for the purpose of pattern testing we should compare
+;;; printreps. [The latter makes the primitive patterns like VAR
+;;; reserved words.]
+(defvar *caller-pattern-table* (make-hash-table :test #'equal)
+  "Stores patterns for function destructuring.")
+(defun lookup-caller-pattern (name)
+  (gethash name *caller-pattern-table*))
+(defmacro define-caller-pattern (name pattern &optional caller-type)
+  "Defines NAME as a function/macro call with argument structure
+   described by PATTERN. CALLER-TYPE, if specified, assigns a type to
+   the pattern, which may be used to exclude references to NAME while
+   viewing the database. For example, all the Common Lisp definitions
+   have a caller-type of :lisp or :lisp2, so that you can exclude 
+   references to common lisp functions from the calling tree."
+  `(progn
+     (when ',caller-type
+       (setf (pattern-caller-type ',name) ',caller-type))
+     (when ',pattern 
+       (setf (gethash ',name *caller-pattern-table*)
+	     ',pattern))))
+
+;;; For defining variables
+(defmacro define-variable-pattern (name &optional caller-type)
+  "Defines NAME as a variable reference of type CALLER-TYPE. This is
+   mainly used to establish the caller-type of the variable."
+  `(progn
+     (when ',caller-type
+       (setf (pattern-caller-type ',name) ',caller-type))))
+
+;;; For defining synonyms. Means much less space taken up by the patterns.
+(defmacro define-caller-pattern-synonyms (source destinations)
+  "For defining function caller pattern syntax synonyms. For each name
+   in DESTINATIONS, defines its pattern as a copy of the definition of SOURCE.
+   Allows a large number of identical patterns to be defined simultaneously.
+   Must occur after the SOURCE has been defined."
+  `(let ((source-type (pattern-caller-type ',source))
+	 (source-pattern (gethash ',source *caller-pattern-table*)))
+     (when source-type
+       (dolist (dest ',destinations)
+	 (setf (pattern-caller-type dest) source-type)))
+     (when source-pattern
+       (dolist (dest ',destinations)
+	 (setf (gethash dest *caller-pattern-table*)
+	       source-pattern)))))
+
+(defun clear-patterns ()
+  (clrhash *pattern-substitution-table*)
+  (clrhash *caller-pattern-table*)
+  (clrhash *pattern-caller-type*))
+
+;;; ********************************
+;;; Cross Reference Files **********
+;;; ********************************
+(defvar *last-form* ()
+  "The last form read from the file. Useful for figuring out what went wrong
+   when xref-file drops into the debugger.")
+
+(defvar *xref-verbose* t
+  "When T, xref-file(s) prints out the names of the files it looks at,
+   progress dots, and the number of forms read.")
+
+;;; This needs to first clear the tables?
+(defun xref-files (&rest files)
+  "Grovels over the lisp code located in source file FILES, using xref-file."
+  ;; If the arg is a list, use it.
+  (when (listp (car files)) (setq files (car files)))
+  (dolist (file files)
+    (xref-file file nil))
+  (values))
+
+(defvar *handle-package-forms* nil	;'(lisp::in-package)
+  "When non-NIL, and XREF-FILE sees a package-setting form like IN-PACKAGE,
+   sets the current package to the specified package by evaluating the
+   form. When done with the file, xref-file resets the package to its 
+   original value. In some of the displaying functions, when this variable
+   is non-NIL one may specify that all symbols from a particular set of
+   packages be ignored. This is only useful if the files use different
+   packages with conflicting names.")
+
+(defvar *normal-readtable* (copy-readtable nil)
+  "Normal, unadulterated CL readtable.")
+
+(defun xref-file (filename &optional (clear-tables t) (verbose *xref-verbose*))
+  "Cross references the function and variable calls in FILENAME by
+   walking over the source code located in the file. Defaults type of
+   filename to \".lisp\". Chomps on the code using record-callers and
+   record-callers*. If CLEAR-TABLES is T (the default), it clears the callers
+   database before processing the file. Specify CLEAR-TABLES as nil to
+   append to the database. If VERBOSE is T (the default), prints out the
+   name of the file, one progress dot for each form processed, and the
+   total number of forms."
+  ;; Default type to "lisp"
+  (when (and (null (pathname-type filename))
+	     (not  (probe-file filename)))
+    (cond ((stringp filename)
+	   (setf filename (concatenate 'string filename ".lisp")))
+	  ((pathnamep filename)
+	   (setf filename (merge-pathnames filename
+					   (make-pathname :type "lisp"))))))
+  (when clear-tables (clear-tables))
+  (let ((count 0)
+	(old-package *package*)
+	(*readtable* *normal-readtable*))
+    (when verbose
+      (format t "~&Cross-referencing file ~A.~&" filename))
+    (with-open-file (stream filename :direction :input)
+      (do ((form (read stream nil :eof) (read stream nil :eof)))
+	  ((eq form :eof))
+	(incf count)
+	(when verbose
+	  (format *standard-output* ".")
+	  (force-output *standard-output*))
+	(setq *last-form* form)
+	(record-callers filename form)
+	;; Package Magic.
+	(when (and *handle-package-forms*
+		   (consp form)
+		   (member (car form) *handle-package-forms*))
+	  (eval form))))
+    (when verbose 
+      (format t "~&~D forms processed." count))
+    (setq *package* old-package)
+    (values)))
+
+(defvar *handle-function-forms* t
+  "When T, XREF-FILE tries to be smart about forms which occur in
+   a function position, such as lambdas and arbitrary Lisp forms.
+   If so, it recursively calls record-callers with pattern 'FORM.
+   If the form is a lambda, makes the caller a caller of :unnamed-lambda.") 
+
+(defvar *handle-macro-forms* t
+  "When T, if the file was loaded before being processed by XREF, and the
+   car of a form is a macro, it notes that the parent calls the macro,
+   and then calls macroexpand-1 on the form.") 
+
+(defvar *callees-database-includes-variables* nil)
+
+(defun record-callers (filename form 
+				&optional pattern parent (environment nil)
+				funcall)
+  "RECORD-CALLERS is the main routine used to walk down the code. It matches
+   the PATTERN against the FORM, possibly adding statements to the database.
+   PARENT is the name defined by the current outermost definition; it is
+   the caller of the forms in the body (e.g., FORM). ENVIRONMENT is used
+   to keep track of the scoping of variables. FUNCALL deals with the type
+   of variable assignment and hence how the environment should be modified.
+   RECORD-CALLERS handles atomic patterns and simple list-structure patterns.
+   For complex list-structure pattern destructuring, it calls RECORD-CALLERS*."
+;  (when form)
+  (unless pattern (setq pattern 'FORM))
+  (cond ((symbolp pattern)
+	 (case pattern
+	   (:IGNORE
+	    ;; Ignores the rest of the form.
+	    (values t parent environment))
+	   (NAME    
+	    ;; This is the name of a new definition.
+	    (push filename (source-file form))
+	    (values t form   environment))
+	   ((FUNCTION MACRO)
+	    ;; This is the name of a call.
+	    (cond ((and *handle-function-forms* (consp form))
+		   ;; If we're a cons and special handling is on,
+		   (when (eq (car form) 'lambda)
+		     (pushnew filename (callers-list :unnamed-lambda :file))
+		     (when parent
+		       (pushnew parent (callers-list :unnamed-lambda
+						     :callers))
+		       (pushnew :unnamed-lambda (callers-list parent
+							      :callees))))
+		   (record-callers filename form 'form parent environment))
+		  (t 
+		   ;; If we're just a regular function name call.
+		   (pushnew filename (callers-list form :file))
+		   (when parent
+		     (pushnew parent (callers-list form :callers))
+		     (pushnew form (callers-list parent :callees)))
+		   (values t parent environment)))) 
+	   (VAR     
+	    ;; This is the name of a new variable definition.
+	    ;; Includes arglist parameters.
+	    (when (and (symbolp form) (not (keywordp form))
+		       (not (member form lambda-list-keywords)))
+	      (pushnew form (car environment))
+	      (pushnew filename (callers-list form :file))
+	      (when parent 
+;		  (pushnew form (callers-list parent :callees))
+		(pushnew parent (callers-list form :setters)))
+	      (values t parent environment)))
+	   (VARIABLE
+	    ;; VAR reference
+	    (pushnew filename (callers-list form :file))
+	    (when (and parent (not (lookup form environment)))
+	      (pushnew parent (callers-list form :readers))
+	      (when *callees-database-includes-variables*
+		(pushnew form (callers-list parent :callees))))
+	    (values t parent environment))
+	   (FORM    
+	    ;; A random form (var or funcall).
+	    (cond ((consp form)
+		   ;; Get new pattern from TAG.
+		   (let ((new-pattern (lookup-caller-pattern (car form))))
+		     (pushnew filename (callers-list (car form) :file))
+		     (when parent
+		       (pushnew parent (callers-list (car form) :callers))
+		       (pushnew (car form) (callers-list parent :callees)))
+		     (cond ((and new-pattern (cdr form))
+			    ;; Special Pattern and there's stuff left
+			    ;; to be processed. Note that we check if
+			    ;; a pattern is defined for the form before
+			    ;; we check to see if we can macroexpand it.
+			    (record-callers filename (cdr form) new-pattern
+					    parent environment :funcall))
+			   ((and *handle-macro-forms*
+				 (symbolp (car form)) ; pnorvig 9/9/93
+				 (macro-function (car form)))
+			    ;; The car of the form is a macro and
+			    ;; macro processing is turned on. Macroexpand-1
+			    ;; the form and try again.
+			    (record-callers filename 
+					    (macroexpand-1 form)
+					    'form parent environment 
+					    :funcall))
+			   ((null (cdr form))
+			    ;; No more left to be processed. Note that
+			    ;; this must occur after the macros clause,
+			    ;; since macros can expand into more code.
+			    (values t parent environment))
+			   (t
+			    ;; Random Form. We assume it is a function call.
+			    (record-callers filename (cdr form)
+					    '((:star FORM))
+					    parent environment :funcall)))))
+		  (t 
+		   (when (and (not (lookup form environment))
+			      (not (numberp form))
+			      ;; the following line should probably be 
+			      ;; commented out?
+			      (not (keywordp form))
+			      (not (stringp form))
+			      (not (eq form t))
+			      (not (eq form nil)))
+		     (pushnew filename (callers-list form :file))
+		     ;; ??? :callers
+		     (when parent
+		       (pushnew parent (callers-list form :readers))
+		       (when *callees-database-includes-variables*
+			 (pushnew form (callers-list parent :callees)))))
+		   (values t parent environment))))
+	   (otherwise 
+	    ;; Pattern Substitution
+	    (let ((new-pattern (lookup-pattern-substitution pattern)))
+	      (if new-pattern
+		  (record-callers filename form new-pattern 
+				  parent environment)
+		  (when (eq pattern form)
+		    (values t parent environment)))))))
+	((consp pattern)
+	 (case (car pattern)
+	   (:eq    (when (eq (second pattern) form)
+		     (values t parent environment)))
+	   (:test  (when (funcall (eval (second pattern)) form)
+		     (values t parent environment)))
+	   (:typep (when (typep form (second pattern))
+		     (values t parent environment)))
+	   (:or    (dolist (subpat (rest pattern))
+		     (multiple-value-bind (processed parent environment)
+			 (record-callers filename form subpat
+					 parent environment)
+		       (when processed
+			 (return (values processed parent environment))))))
+	   (:rest			; (:star :plus :optional :rest)
+	    (record-callers filename form (second pattern)
+			    parent environment))
+	   (otherwise
+	    (multiple-value-bind (d p env)
+		(record-callers* filename form pattern 
+				 parent (cons nil environment))
+	      (values d p (if funcall environment env))))))))
+
+(defun record-callers* (filename form pattern parent environment
+				 &optional continuation 
+				 in-optionals in-keywords)
+  "RECORD-CALLERS* handles complex list-structure patterns, such as
+   ordered lists of subpatterns, patterns involving :star, :plus,
+   &optional, &key, &rest, and so on. CONTINUATION is a stack of
+   unprocessed patterns, IN-OPTIONALS and IN-KEYWORDS are corresponding
+   stacks which determine whether &rest or &key has been seen yet in
+   the current pattern."   
+  ;; form must be a cons or nil.
+;  (when form)
+  (if (null pattern)
+      (if (null continuation)
+	  (values t parent environment)
+	  (record-callers* filename form (car continuation) parent environment
+			   (cdr continuation) 
+			   (cdr in-optionals)
+			   (cdr in-keywords)))
+      (let ((pattern-elt (car pattern)))
+	(cond ((car-eq pattern-elt :optional)
+	       (if (null form) 
+		   (values t parent environment)
+		   (multiple-value-bind (processed par env)
+		       (record-callers* filename form (cdr pattern-elt)
+					parent environment
+					(cons (cdr pattern) continuation)
+					(cons (car in-optionals) in-optionals)
+					(cons (car in-keywords) in-keywords))
+		     (if processed
+			 (values processed par env)
+			 (record-callers* filename form (cdr pattern)
+					  parent environment continuation
+					  in-optionals in-keywords)))))
+	      ((car-eq pattern-elt :star)
+	       (if (null form)
+		   (values t parent environment)
+		   (multiple-value-bind (processed par env)
+		       (record-callers* filename form (cdr pattern-elt)
+					parent environment
+					(cons pattern continuation)
+					(cons (car in-optionals) in-optionals)
+					(cons (car in-keywords) in-keywords))
+		     (if processed
+			 (values processed par env)
+			 (record-callers* filename form (cdr pattern)
+					  parent environment continuation
+					  in-optionals in-keywords)))))
+	      ((car-eq pattern-elt :plus)
+	       (record-callers* filename form (cdr pattern-elt)
+				parent environment
+				(cons (cons (cons :star (cdr pattern-elt))
+					    (cdr pattern))
+				      continuation)
+				(cons (car in-optionals) in-optionals)
+				(cons (car in-keywords) in-keywords)))
+	      ((car-eq pattern-elt :rest)
+	       (record-callers filename form pattern-elt parent environment))
+	      ((eq pattern-elt '&optional)
+	       (record-callers* filename form (cdr pattern)
+				parent environment continuation
+				(cons t in-optionals)
+				(cons (car in-keywords) in-keywords)))
+	      ((eq pattern-elt '&rest)
+	       (record-callers filename form (second pattern)
+			       parent environment))
+	      ((eq pattern-elt '&key)
+	       (record-callers* filename form (cdr pattern)
+				parent environment continuation
+				(cons (car in-optionals) in-optionals)
+				(cons t in-keywords)))
+	      ((null form)
+	       (when (or (car in-keywords) (car in-optionals))
+		 (values t parent environment)))
+	      ((consp form)
+	       (multiple-value-bind (processed parent environment)
+		   (record-callers filename (if (car in-keywords)
+						(cadr form)
+						(car form))
+				   pattern-elt
+				   parent environment)
+		 (cond (processed
+			(record-callers* filename (if (car in-keywords)
+						      (cddr form)
+						      (cdr form))
+					 (cdr pattern)
+					 parent environment
+					 continuation
+					 in-optionals in-keywords))
+		       ((or (car in-keywords)
+			    (car in-optionals))
+			(values t parent environment)))))))))
+
+
+;;; ********************************
+;;; Misc Utilities *****************
+;;; ********************************
+(defvar *types-to-ignore*
+  '(:lisp				; CLtL 1st Edition
+    :lisp2				; CLtL 2nd Edition additional patterns
+    )
+  "Default set of caller types (as specified in the patterns) to ignore
+   in the database handling functions. :lisp is CLtL 1st edition,
+   :lisp2 is additional patterns from CLtL 2nd edition.")
+
+(defun display-database (&optional (database :callers) 
+				   (types-to-ignore *types-to-ignore*))
+  "Prints out the name of each symbol and all its callers. Specify database
+   :callers (the default) to get function call references, :fill to the get
+   files in which the symbol is called, :readers to get variable references,
+   and :setters to get variable binding and assignments. Ignores functions
+   of types listed in types-to-ignore."
+  (maphash #'(lambda (name callers)
+	       (unless (or (member (pattern-caller-type name)
+				   types-to-ignore)
+			   ;; When we're doing fancy package crap,
+			   ;; allow us to ignore symbols based on their
+			   ;; packages.
+			   (when *handle-package-forms*
+			     (member (symbol-package name)
+				     types-to-ignore
+				     :key #'find-package)))
+		 (format t "~&~S is referenced by~{ ~S~}."
+			 name callers)))
+	   (ecase database
+	     (:file    *file-callers-database*)
+	     (:callers *callers-database*)
+	     (:readers *readers-database*)
+	     (:setters *setters-database*))))
+
+(defun write-callers-database-to-file (filename)
+  "Saves the contents of the current callers database to a file. This
+   file can be loaded to restore the previous contents of the
+   database. (For large systems it can take a long time to crunch
+   through the code, so this can save some time.)"
+  (with-open-file (stream filename :direction :output)
+    (format stream "~&(clear-tables)")
+    (maphash #'(lambda (x y) 
+		 (format stream "~&(setf (source-file '~S) '~S)"
+			 x y))
+	     *source-file*)
+    (maphash #'(lambda (x y) 
+		 (format stream "~&(setf (callers-list '~S :file) '~S)"
+			 x y))
+	     *file-callers-database*)
+    (maphash #'(lambda (x y) 
+		 (format stream "~&(setf (callers-list '~S :callers) '~S)"
+			 x y))
+	     *callers-database*)
+    (maphash #'(lambda (x y) 
+		 (format stream "~&(setf (callers-list '~S :callees) '~S)"
+			 x y))
+	     *callees-database*)
+    (maphash #'(lambda (x y) 
+		 (format stream "~&(setf (callers-list '~S :readers) '~S)"
+			 x y))
+	     *readers-database*)
+    (maphash #'(lambda (x y) 
+		 (format stream "~&(setf (callers-list '~S :setters) '~S)"
+			 x y))
+	     *setters-database*)))
+
+
+;;; ********************************
+;;; Print Caller Trees *************
+;;; ********************************
+;;; The following function is useful for reversing a caller table into
+;;; a callee table. Possibly later we'll extend xref to create two 
+;;; such database hash tables. Needs to include vars as well.
+(defun invert-hash-table (table &optional (types-to-ignore *types-to-ignore*))
+  "Makes a copy of the hash table in which (name value*) pairs
+   are inverted to (value name*) pairs."
+  (let ((target (make-hash-table :test #'equal)))
+    (maphash #'(lambda (key values)
+		 (dolist (value values)
+		   (unless (member (pattern-caller-type key) 
+				   types-to-ignore)
+		     (pushnew key (gethash value target)))))
+	     table)
+    target))
+
+;;; Resolve file references for automatic creation of a defsystem file.
+(defun determine-file-dependencies (&optional (database *callers-database*))
+  "Makes a hash table of file dependencies for the references listed in
+   DATABASE. This function may be useful for automatically resolving
+   file references for automatic creation of a system definition (defsystem)."
+  (let ((file-ref-ht  (make-hash-table :test #'equal)))
+    (maphash #'(lambda (key values)
+		 (let ((key-file (source-file key)))
+		   (when key
+		     (dolist (value values)
+		       (let ((value-file (source-file value)))
+			 (when value-file
+			   (dolist (s key-file)
+			     (dolist (d value-file)
+			       (pushnew d (gethash s file-ref-ht))))))))))
+	     database)
+    file-ref-ht))
+
+(defun print-file-dependencies (&optional (database *callers-database*))
+  "Prints a list of file dependencies for the references listed in DATABASE.
+   This function may be useful for automatically computing file loading
+   constraints for a system definition tool."
+  (maphash #'(lambda (key value) (format t "~&~S --> ~S" key value))
+	   (determine-file-dependencies database)))
+
+;;; The following functions demonstrate a possible way to interface
+;;; xref to a graphical browser such as psgraph to mimic the capabilities
+;;; of Masterscope's graphical browser. 
+
+(defvar *last-caller-tree* nil)
+
+(defvar *default-graphing-mode* :call-graph
+  "Specifies whether we graph up or down. If :call-graph, the children
+   of a node are the functions it calls. If :caller-graph, the children
+   of a node are the functions that call it.") 
+
+(defun gather-tree (parents &optional already-seen 
+			    (mode *default-graphing-mode*)
+			    (types-to-ignore *types-to-ignore*) compact)
+  "Extends the tree, copying it into list structure, until it repeats
+   a reference (hits a cycle)."
+  (let ((*already-seen* nil)
+	(database (case mode
+		    (:call-graph   *callees-database*)
+		    (:caller-graph *callers-database*))))
+    (declare (special *already-seen*))
+    (labels 
+	((amass-tree
+	  (parents &optional already-seen)
+	  (let (result this-item)
+	    (dolist (parent parents)
+	      (unless (member (pattern-caller-type parent)
+			      types-to-ignore)
+		(pushnew parent *already-seen*)
+		(if (member parent already-seen)
+		    (setq this-item nil) ; :ignore
+		    (if compact 
+			(multiple-value-setq (this-item already-seen)
+			    (amass-tree (gethash parent database)
+					(cons parent already-seen)))
+			(setq this-item
+			      (amass-tree (gethash parent database)
+					  (cons parent already-seen)))))
+		(setq parent (format nil "~S" parent))
+		(when (consp parent) (setq parent (cons :xref-list parent)))
+		(unless (eq this-item :ignore)
+		  (push (if this-item
+			    (list parent this-item)
+			    parent) 
+			result))))
+	    (values result		;(reverse result)
+		    already-seen))))
+      (values (amass-tree parents already-seen)
+	      *already-seen*))))
+
+(defun find-roots-and-cycles (&optional (mode *default-graphing-mode*)
+					(types-to-ignore *types-to-ignore*))
+  "Returns a list of uncalled callers (roots) and called callers (potential
+   cycles)."
+  (let ((uncalled-callers nil)
+	(called-callers nil)
+	(database (ecase mode
+		    (:call-graph   *callers-database*)
+		    (:caller-graph *callees-database*)))
+	(other-database (ecase mode
+			  (:call-graph   *callees-database*)
+			  (:caller-graph *callers-database*))))
+    (maphash #'(lambda (name value)
+		 (declare (ignore value))
+		 (unless (member (pattern-caller-type name) 
+				 types-to-ignore)
+		   (if (gethash name database)
+		       (push name called-callers)
+		       (push name uncalled-callers))))
+	     other-database)
+    (values uncalled-callers called-callers)))
+
+(defun make-caller-tree (&optional (mode *default-graphing-mode*)
+				   (types-to-ignore *types-to-ignore*) compact)
+  "Outputs list structure of a tree which roughly represents the possibly
+   cyclical structure of the caller database.
+   If mode is :call-graph, the children of a node are the functions it calls.
+   If mode is :caller-graph, the children of a node are the functions that
+   call it.
+   If compact is T, tries to eliminate the already-seen nodes, so that
+   the graph for a node is printed at most once. Otherwise it will duplicate
+   the node's tree (except for cycles). This is usefull because the call tree
+   is actually a directed graph, so we can either duplicate references or
+   display only the first one."
+  ;; Would be nice to print out line numbers and whenever we skip a duplicated
+  ;; reference, print the line number of the full reference after the node.
+  (multiple-value-bind (uncalled-callers called-callers)
+      (find-roots-and-cycles mode types-to-ignore)
+    (multiple-value-bind (trees already-seen)
+	(gather-tree uncalled-callers nil mode types-to-ignore compact)
+      (setq *last-caller-tree* trees)
+      (let ((more-trees (gather-tree (set-difference called-callers
+						     already-seen)
+				     already-seen 
+				     mode types-to-ignore compact)))
+	(values trees more-trees)))))
+
+(defvar *indent-amount* 3
+  "Number of spaces to indent successive levels in PRINT-INDENTED-TREE.")
+
+(defun print-indented-tree (trees &optional (indent 0))
+  "Simple code to print out a list-structure tree (such as those created
+   by make-caller-tree) as indented text."
+  (when trees
+    (dolist (tree trees)
+      (cond ((and (listp tree) (eq (car tree) :xref-list))
+	     (format t "~&~VT~A" indent (cdr tree)))
+	    ((listp tree)
+	     (format t "~&~VT~A" indent (car tree))
+	     (print-indented-tree (cadr tree) (+ indent *indent-amount*)))
+	    (t
+	     (format t "~&~VT~A" indent tree))))))
+
+(defun print-caller-trees (&key (mode *default-graphing-mode*)
+				(types-to-ignore *types-to-ignore*)
+				compact
+				root-nodes)
+  "Prints the calling trees (which may actually be a full graph and not
+   necessarily a DAG) as indented text trees using PRINT-INDENTED-TREE.
+   MODE is :call-graph for trees where the children of a node are the
+   functions called by the node, or :caller-graph for trees where the
+   children of a node are the functions the node calls. TYPES-TO-IGNORE
+   is a list of funcall types (as specified in the patterns) to ignore
+   in printing out the database. For example, '(:lisp) would ignore all
+   calls to common lisp functions. COMPACT is a flag to tell the program
+   to try to compact the trees a bit by not printing trees if they have
+   already been seen. ROOT-NODES is a list of root nodes of trees to 
+   display. If ROOT-NODES is nil, tries to find all root nodes in the
+   database."
+  (multiple-value-bind (rooted cycles)
+      (if root-nodes
+	  (values (gather-tree root-nodes nil mode types-to-ignore compact))
+	  (make-caller-tree mode types-to-ignore compact))
+    (when rooted
+      (format t "~&Rooted calling trees:")
+      (print-indented-tree rooted 2))
+    (when cycles
+      (when rooted      
+	(format t "~2%"))
+      (format t "~&Cyclic calling trees:")
+      (print-indented-tree cycles 2))))
+
+
+;;; ********************************
+;;; Interface to PSGraph ***********
+;;; ********************************
+#|
+;;; Interface to Bates' PostScript Graphing Utility
+(load "/afs/cs/user/mkant/Lisp/PSGraph/psgraph")
+
+(defparameter *postscript-output-directory* "")
+(defun psgraph-xref (&key (mode *default-graphing-mode*)
+			  (output-directory *postscript-output-directory*)
+			  (types-to-ignore *types-to-ignore*)
+			  (compact t)
+			  (shrink t)
+			  root-nodes
+			  insert)
+  ;; If root-nodes is a non-nil list, uses that list as the starting
+  ;; position. Otherwise tries to find all roots in the database.
+  (multiple-value-bind (rooted cycles)
+      (if root-nodes
+	  (values (gather-tree root-nodes nil mode types-to-ignore compact))
+	  (make-caller-tree mode types-to-ignore compact))
+    (psgraph-output (append rooted cycles) output-directory shrink insert)))
+
+(defun psgraph-output (list-of-trees directory shrink &optional insert)
+  (let ((psgraph:*fontsize* 9)
+	(psgraph:*second-fontsize* 7)
+;	(psgraph:*boxkind* "fill")
+	(psgraph:*boxgray* "0") ; .8
+	(psgraph:*edgewidth* "1")
+	(psgraph:*edgegray* "0"))
+    (labels ((stringify (thing)
+		(cond ((stringp thing) (string-downcase thing))
+		      ((symbolp thing) (string-downcase (symbol-name thing)))
+		      ((and (listp thing) (eq (car thing) :xref-list))
+		       (stringify (cdr thing)))
+		      ((listp thing) (stringify (car thing)))
+		      (t (string thing)))))
+      (dolist (item list-of-trees)
+	(let* ((fname (stringify item))
+	       (filename (concatenate 'string directory
+				      (string-trim '(#\: #\|) fname)
+				      ".ps")))
+	  (format t "~&Creating PostScript file ~S." filename)
+	  (with-open-file (*standard-output* filename
+					     :direction :output
+					     :if-does-not-exist :create
+					     :if-exists :supersede)
+	    ;; Note that the #'eq prints the DAG as a tree. If
+	    ;; you replace it with #'equal, it will print it as
+	    ;; a DAG, which I think is slightly ugly.
+	    (psgraph:psgraph item
+			     #'caller-tree-children #'caller-info shrink
+			     insert #'eq)))))))
+
+(defun caller-tree-children (tree)
+  (when (and tree (listp tree) (not (eq (car tree) :xref-list)))
+    (cadr tree)))
+
+(defun caller-tree-node (tree)
+  (when tree
+    (cond ((and (listp tree) (eq (car tree) :xref-list))
+	   (cdr tree))
+	  ((listp tree)
+	   (car tree))
+	  (t
+	   tree))))
+
+(defun caller-info (tree)
+  (let ((node (caller-tree-node tree)))
+    (list node)))
+|#
+#|
+;;; Code to print out graphical trees of CLOS class hierarchies.
+(defun print-class-hierarchy (&optional (start-class 'anything) 
+					(file "classes.ps"))
+  (let ((start (find-class start-class)))
+    (when start
+      (with-open-file (*standard-output* file :direction :output)
+	(psgraph:psgraph start 
+			 #'clos::class-direct-subclasses
+			 #'(lambda (x) 
+			     (list (format nil "~A" (clos::class-name x))))
+			 t nil #'eq)))))
+
+|#
+
+
+;;; ****************************************************************
+;;; Cross Referencing Patterns for Common Lisp *********************
+;;; ****************************************************************
+(clear-patterns)
+
+;;; ********************************
+;;; Pattern Substitutions **********
+;;; ********************************
+(define-pattern-substitution integer (:test #'integerp))
+(define-pattern-substitution rational (:test #'rationalp))
+(define-pattern-substitution symbol  (:test #'symbolp))
+(define-pattern-substitution string  (:test #'stringp))
+(define-pattern-substitution number  (:test #'numberp))
+(define-pattern-substitution lambda-list
+  ((:star var)
+   (:optional (:eq &optional)
+	      (:star (:or var
+			  (var (:optional form (:optional var))))))
+   (:optional (:eq &rest) var)
+   (:optional (:eq &key) (:star (:or var
+			       ((:or var
+				     (keyword var))
+				(:optional form (:optional var)))))
+	      (:optional &allow-other-keys))
+   (:optional (:eq &aux)
+	      (:star (:or var
+			  (var (:optional form)))))))
+(define-pattern-substitution test form)
+(define-pattern-substitution body
+  ((:star (:or declaration documentation-string))
+   (:star form)))
+(define-pattern-substitution documentation-string string)
+(define-pattern-substitution initial-value form)
+(define-pattern-substitution tag symbol)
+(define-pattern-substitution declaration ((:eq declare)(:rest :ignore)))
+(define-pattern-substitution destination form)
+(define-pattern-substitution control-string string)
+(define-pattern-substitution format-arguments 
+  ((:star form)))
+(define-pattern-substitution fn
+  (:or ((:eq quote) function) 
+       ((:eq function) function)
+       function))
+
+;;; ********************************
+;;; Caller Patterns ****************
+;;; ********************************
+
+;;; Types Related
+(define-caller-pattern coerce (form :ignore) :lisp)
+(define-caller-pattern type-of (form) :lisp)
+(define-caller-pattern upgraded-array-element-type (:ignore) :lisp2)
+(define-caller-pattern upgraded-complex-part-type (:ignore) :lisp2)
+
+;;; Lambdas and Definitions
+(define-variable-pattern lambda-list-keywords :lisp)
+(define-variable-pattern lambda-parameters-limit :lisp)
+(define-caller-pattern lambda (lambda-list (:rest body)) :lisp)
+
+(define-caller-pattern defun 
+  (name lambda-list
+	(:star (:or documentation-string declaration))
+	(:star form))
+  :lisp)
+
+;;; perhaps this should use VAR, instead of NAME
+(define-caller-pattern defvar 
+  (var (:optional initial-value (:optional documentation-string)))
+  :lisp)
+(define-caller-pattern defparameter
+  (var initial-value (:optional documentation-string))
+  :lisp)
+(define-caller-pattern defconstant
+  (var initial-value (:optional documentation-string))
+  :lisp)
+
+(define-caller-pattern eval-when
+  (:ignore				; the situations
+   (:star form))
+  :lisp)
+
+;;; Logical Values
+(define-variable-pattern nil :lisp)
+(define-variable-pattern t :lisp)
+
+;;; Predicates
+(define-caller-pattern typep (form form) :lisp)
+(define-caller-pattern subtypep (form form) :lisp)
+
+(define-caller-pattern null (form) :lisp)
+(define-caller-pattern symbolp (form) :lisp)
+(define-caller-pattern atom (form) :lisp)
+(define-caller-pattern consp (form) :lisp)
+(define-caller-pattern listp (form) :lisp)
+(define-caller-pattern numberp (form) :lisp)
+(define-caller-pattern integerp (form) :lisp)
+(define-caller-pattern rationalp (form) :lisp)
+(define-caller-pattern floatp (form) :lisp)
+(define-caller-pattern realp (form) :lisp2)
+(define-caller-pattern complexp (form) :lisp)
+(define-caller-pattern characterp (form) :lisp)
+(define-caller-pattern stringp (form) :lisp)
+(define-caller-pattern bit-vector-p (form) :lisp)
+(define-caller-pattern vectorp (form) :lisp)
+(define-caller-pattern simple-vector-p (form) :lisp)
+(define-caller-pattern simple-string-p (form) :lisp)
+(define-caller-pattern simple-bit-vector-p (form) :lisp)
+(define-caller-pattern arrayp (form) :lisp)
+(define-caller-pattern packagep (form) :lisp)
+(define-caller-pattern functionp (form) :lisp)
+(define-caller-pattern compiled-function-p (form) :lisp)
+(define-caller-pattern commonp (form) :lisp)
+
+;;; Equality Predicates
+(define-caller-pattern eq (form form) :lisp)
+(define-caller-pattern eql (form form) :lisp)
+(define-caller-pattern equal (form form) :lisp)
+(define-caller-pattern equalp (form form) :lisp)
+
+;;; Logical Operators
+(define-caller-pattern not (form) :lisp)
+(define-caller-pattern or ((:star form)) :lisp)
+(define-caller-pattern and ((:star form)) :lisp)
+
+;;; Reference
+
+;;; Quote is a problem. In Defmacro & friends, we'd like to actually
+;;; look at the argument, 'cause it hides internal function calls
+;;; of the defmacro. 
+(define-caller-pattern quote (:ignore) :lisp)
+
+(define-caller-pattern function ((:or fn form)) :lisp)
+(define-caller-pattern symbol-value (form) :lisp)
+(define-caller-pattern symbol-function (form) :lisp)
+(define-caller-pattern fdefinition (form) :lisp2)
+(define-caller-pattern boundp (form) :lisp)
+(define-caller-pattern fboundp (form) :lisp)
+(define-caller-pattern special-form-p (form) :lisp)
+
+;;; Assignment
+(define-caller-pattern setq ((:star var form)) :lisp)
+(define-caller-pattern psetq ((:star var form)) :lisp)
+(define-caller-pattern set (form form) :lisp)
+(define-caller-pattern makunbound (form) :lisp)
+(define-caller-pattern fmakunbound (form) :lisp)
+
+;;; Generalized Variables
+(define-caller-pattern setf ((:star form form)) :lisp)
+(define-caller-pattern psetf ((:star form form)) :lisp)
+(define-caller-pattern shiftf ((:plus form) form) :lisp)
+(define-caller-pattern rotatef ((:star form)) :lisp)
+(define-caller-pattern define-modify-macro 
+  (name
+   lambda-list
+   fn
+   (:optional documentation-string))
+  :lisp)
+(define-caller-pattern defsetf 
+  (:or (name name (:optional documentation-string))
+       (name lambda-list (var)
+	(:star (:or declaration documentation-string))
+	(:star form)))
+  :lisp)
+(define-caller-pattern define-setf-method
+  (name lambda-list
+   (:star (:or declaration documentation-string))
+   (:star form))
+  :lisp)
+(define-caller-pattern get-setf-method (form) :lisp)
+(define-caller-pattern get-setf-method-multiple-value (form) :lisp)
+
+
+;;; Function invocation
+(define-caller-pattern apply (fn form (:star form)) :lisp)
+(define-caller-pattern funcall (fn (:star form)) :lisp)
+
+
+;;; Simple sequencing
+(define-caller-pattern progn ((:star form)) :lisp)
+(define-caller-pattern prog1 (form (:star form)) :lisp)
+(define-caller-pattern prog2 (form form (:star form)) :lisp)
+
+;;; Variable bindings
+(define-caller-pattern let
+  (((:star (:or var (var &optional form))))
+   (:star declaration)
+   (:star form))
+  :lisp)
+(define-caller-pattern let*
+  (((:star (:or var (var &optional form))))
+    (:star declaration)
+    (:star form))
+  :lisp)
+(define-caller-pattern compiler-let
+  (((:star (:or var (var form))))
+    (:star form))
+  :lisp)
+(define-caller-pattern progv
+  (form form (:star form)) :lisp)
+(define-caller-pattern flet
+  (((:star (name lambda-list 
+		 (:star (:or declaration
+			     documentation-string))
+		 (:star form))))
+   (:star form))
+  :lisp)
+(define-caller-pattern labels
+  (((:star (name lambda-list 
+		 (:star (:or declaration
+			     documentation-string))
+		 (:star form))))
+   (:star form))
+  :lisp)
+(define-caller-pattern macrolet
+  (((:star (name lambda-list 
+		 (:star (:or declaration
+			     documentation-string))
+		 (:star form))))
+   (:star form))
+  :lisp)
+(define-caller-pattern symbol-macrolet
+  (((:star (var form))) (:star declaration) (:star form))
+  :lisp2)
+
+;;; Conditionals
+(define-caller-pattern if (test form (:optional form)) :lisp)
+(define-caller-pattern when (test (:star form)) :lisp)
+(define-caller-pattern unless (test (:star form)) :lisp)
+(define-caller-pattern cond ((:star (test (:star form)))) :lisp)
+(define-caller-pattern case
+  (form
+   (:star ((:or symbol
+		((:star symbol)))
+	   (:star form)))) 
+  :lisp)
+(define-caller-pattern typecase (form (:star (symbol (:star form)))) 
+  :lisp)
+
+;;; Blocks and Exits
+(define-caller-pattern block (name (:star form)) :lisp)
+(define-caller-pattern return-from (function (:optional form)) :lisp)
+(define-caller-pattern return ((:optional form)) :lisp)
+
+;;; Iteration
+(define-caller-pattern loop ((:star form)) :lisp)
+(define-caller-pattern do
+  (((:star (:or var
+		(var (:optional form (:optional form)))))) ; init step
+   (form (:star form)) ; end-test result
+   (:star declaration)
+   (:star (:or tag form)))		; statement
+  :lisp)
+(define-caller-pattern do*
+  (((:star (:or var
+		(var (:optional form (:optional form)))))) 
+   (form (:star form))
+   (:star declaration)
+   (:star (:or tag form)))
+  :lisp)
+(define-caller-pattern dolist
+  ((var form (:optional form))
+   (:star declaration)
+   (:star (:or tag form)))
+  :lisp)
+(define-caller-pattern dotimes
+  ((var form (:optional form))
+   (:star declaration)
+   (:star (:or tag form)))
+  :lisp)
+
+;;; Mapping
+(define-caller-pattern mapcar (fn form (:star form)) :lisp)
+(define-caller-pattern maplist (fn form (:star form)) :lisp)
+(define-caller-pattern mapc (fn form (:star form)) :lisp)
+(define-caller-pattern mapl (fn form (:star form)) :lisp)
+(define-caller-pattern mapcan (fn form (:star form)) :lisp)
+(define-caller-pattern mapcon (fn form (:star form)) :lisp)
+
+;;; The "Program Feature"
+(define-caller-pattern tagbody ((:star (:or tag form))) :lisp)
+(define-caller-pattern prog
+  (((:star (:or var (var (:optional form)))))
+   (:star declaration)
+   (:star (:or tag form)))
+  :lisp)
+(define-caller-pattern prog*    
+  (((:star (:or var (var (:optional form)))))
+   (:star declaration)
+   (:star (:or tag form)))
+  :lisp)
+(define-caller-pattern go (tag) :lisp)
+
+;;; Multiple Values
+(define-caller-pattern values ((:star form)) :lisp)
+(define-variable-pattern multiple-values-limit :lisp)
+(define-caller-pattern values-list (form) :lisp)
+(define-caller-pattern multiple-value-list (form) :lisp)
+(define-caller-pattern multiple-value-call (fn (:star form)) :lisp)
+(define-caller-pattern multiple-value-prog1 (form (:star form)) :lisp)
+(define-caller-pattern multiple-value-bind
+  (((:star var)) form
+   (:star declaration)
+   (:star form))
+  :lisp)
+(define-caller-pattern multiple-value-setq (((:star var)) form) :lisp)
+(define-caller-pattern nth-value (form form) :lisp2)
+
+;;; Dynamic Non-Local Exits
+(define-caller-pattern catch (tag (:star form)) :lisp)
+(define-caller-pattern throw (tag form) :lisp)
+(define-caller-pattern unwind-protect (form (:star form)) :lisp)
+
+;;; Macros
+(define-caller-pattern macro-function (form) :lisp)
+(define-caller-pattern defmacro
+  (name
+   lambda-list
+   (:star (:or declaration documentation-string))
+   (:star form))
+  :lisp)
+(define-caller-pattern macroexpand (form (:optional :ignore)) :lisp)
+(define-caller-pattern macroexpand-1 (form (:optional :ignore)) :lisp)
+(define-variable-pattern *macroexpand-hook* :lisp)
+
+;;; Destructuring
+(define-caller-pattern destructuring-bind 
+  (lambda-list form
+	       (:star declaration)
+	       (:star form))
+  :lisp2)
+
+;;; Compiler Macros
+(define-caller-pattern define-compiler-macro
+  (name lambda-list
+	(:star (:or declaration documentation-string))
+	(:star form))
+  :lisp2)
+(define-caller-pattern compiler-macro-function (form) :lisp2)
+(define-caller-pattern compiler-macroexpand (form (:optional :ignore)) :lisp2)
+(define-caller-pattern compiler-macroexpand-1 (form (:optional :ignore)) :lisp2)
+
+;;; Environments
+(define-caller-pattern variable-information (form &optional :ignore) 
+  :lisp2)
+(define-caller-pattern function-information (fn &optional :ignore) :lisp2)
+(define-caller-pattern declaration-information (form &optional :ignore) :lisp2)
+(define-caller-pattern augment-environment (form &key (:star :ignore)) :lisp2)
+(define-caller-pattern define-declaration 
+  (name
+   lambda-list
+   (:star form)) 
+  :lisp2)
+(define-caller-pattern parse-macro (name lambda-list form) :lisp2)
+(define-caller-pattern enclose (form &optional :ignore) :lisp2)
+
+
+;;; Declarations
+(define-caller-pattern declare ((:rest :ignore)) :lisp)
+(define-caller-pattern proclaim ((:rest :ignore)) :lisp)
+(define-caller-pattern locally ((:star declaration) (:star form)) :lisp)
+(define-caller-pattern declaim ((:rest :ignore)) :lisp2)
+(define-caller-pattern the (form form) :lisp)
+
+;;; Symbols
+(define-caller-pattern get (form form (:optional form)) :lisp)
+(define-caller-pattern remprop (form form) :lisp)
+(define-caller-pattern symbol-plist (form) :lisp)
+(define-caller-pattern getf (form form (:optional form)) :lisp)
+(define-caller-pattern remf (form form) :lisp)
+(define-caller-pattern get-properties (form form) :lisp)
+
+(define-caller-pattern symbol-name (form) :lisp)
+(define-caller-pattern make-symbol (form) :lisp)
+(define-caller-pattern copy-symbol (form (:optional :ignore)) :lisp)
+(define-caller-pattern gensym ((:optional :ignore)) :lisp)
+(define-variable-pattern *gensym-counter* :lisp2)
+(define-caller-pattern gentemp ((:optional :ignore :ignore)) :lisp)
+(define-caller-pattern symbol-package (form) :lisp)
+(define-caller-pattern keywordp (form) :lisp)
+
+;;; Packages
+(define-variable-pattern *package* :lisp)
+(define-caller-pattern make-package ((:rest :ignore)) :lisp)
+(define-caller-pattern in-package ((:rest :ignore)) :lisp)
+(define-caller-pattern find-package ((:rest :ignore)) :lisp)
+(define-caller-pattern package-name ((:rest :ignore)) :lisp)
+(define-caller-pattern package-nicknames ((:rest :ignore)) :lisp)
+(define-caller-pattern rename-package ((:rest :ignore)) :lisp)
+(define-caller-pattern package-use-list ((:rest :ignore)) :lisp)
+(define-caller-pattern package-used-by-list ((:rest :ignore)) :lisp)
+(define-caller-pattern package-shadowing-symbols ((:rest :ignore)) :lisp)
+(define-caller-pattern list-all-packages () :lisp)
+(define-caller-pattern delete-package ((:rest :ignore)) :lisp2)
+(define-caller-pattern intern (form &optional :ignore) :lisp)
+(define-caller-pattern find-symbol (form &optional :ignore) :lisp)
+(define-caller-pattern unintern (form &optional :ignore) :lisp)
+
+(define-caller-pattern export ((:or symbol ((:star symbol)))
+			       &optional :ignore) :lisp)
+(define-caller-pattern unexport ((:or symbol ((:star symbol)))
+			       &optional :ignore) :lisp)
+(define-caller-pattern import ((:or symbol ((:star symbol)))
+			       &optional :ignore) :lisp)
+(define-caller-pattern shadowing-import ((:or symbol ((:star symbol)))
+			       &optional :ignore) :lisp)
+(define-caller-pattern shadow ((:or symbol ((:star symbol)))
+			       &optional :ignore) :lisp)
+
+(define-caller-pattern use-package ((:rest :ignore)) :lisp)
+(define-caller-pattern unuse-package ((:rest :ignore)) :lisp)
+(define-caller-pattern defpackage (name (:rest :ignore)) :lisp2)
+(define-caller-pattern find-all-symbols (form) :lisp)
+(define-caller-pattern do-symbols 
+  ((var (:optional form (:optional form)))
+   (:star declaration) 
+   (:star (:or tag form))) 
+  :lisp)
+(define-caller-pattern do-external-symbols 
+  ((var (:optional form (:optional form)))
+   (:star declaration) 
+   (:star (:or tag form))) 
+  :lisp)
+(define-caller-pattern do-all-symbols 
+  ((var (:optional form))
+   (:star declaration) 
+   (:star (:or tag form))) 
+  :lisp)
+(define-caller-pattern with-package-iterator
+  ((name form (:plus :ignore))
+   (:star form))
+  :lisp2)
+
+;;; Modules
+(define-variable-pattern *modules* :lisp)
+(define-caller-pattern provide (form) :lisp)
+(define-caller-pattern require (form &optional :ignore) :lisp)
+
+
+;;; Numbers
+(define-caller-pattern zerop (form) :lisp)
+(define-caller-pattern plusp (form) :lisp)
+(define-caller-pattern minusp (form) :lisp)
+(define-caller-pattern oddp (form) :lisp)
+(define-caller-pattern evenp (form) :lisp)
+
+(define-caller-pattern = (form (:star form)) :lisp)
+(define-caller-pattern /= (form (:star form)) :lisp)
+(define-caller-pattern > (form (:star form)) :lisp)
+(define-caller-pattern < (form (:star form)) :lisp)
+(define-caller-pattern <= (form (:star form)) :lisp)
+(define-caller-pattern >= (form (:star form)) :lisp)
+
+(define-caller-pattern max (form (:star form)) :lisp)
+(define-caller-pattern min (form (:star form)) :lisp)
+
+(define-caller-pattern - (form (:star form)) :lisp)
+(define-caller-pattern + (form (:star form)) :lisp)
+(define-caller-pattern * (form (:star form)) :lisp)
+(define-caller-pattern / (form (:star form)) :lisp)
+(define-caller-pattern 1+ (form) :lisp)
+(define-caller-pattern 1- (form) :lisp)
+
+(define-caller-pattern incf (form form) :lisp)
+(define-caller-pattern decf (form form) :lisp)
+
+(define-caller-pattern conjugate (form) :lisp)
+
+(define-caller-pattern gcd ((:star form)) :lisp)
+(define-caller-pattern lcm ((:star form)) :lisp)
+
+(define-caller-pattern exp (form) :lisp)
+(define-caller-pattern expt (form form) :lisp)
+(define-caller-pattern log (form (:optional form)) :lisp)
+(define-caller-pattern sqrt (form) :lisp)
+(define-caller-pattern isqrt (form) :lisp)
+
+(define-caller-pattern abs (form) :lisp)
+(define-caller-pattern phase (form) :lisp)
+(define-caller-pattern signum (form) :lisp)
+(define-caller-pattern sin (form) :lisp)
+(define-caller-pattern cos (form) :lisp)
+(define-caller-pattern tan (form) :lisp)
+(define-caller-pattern cis (form) :lisp)
+(define-caller-pattern asin (form) :lisp)
+(define-caller-pattern acos (form) :lisp)
+(define-caller-pattern atan (form &optional form) :lisp)
+(define-variable-pattern pi :lisp)
+
+(define-caller-pattern sinh (form) :lisp)
+(define-caller-pattern cosh (form) :lisp)
+(define-caller-pattern tanh (form) :lisp)
+(define-caller-pattern asinh (form) :lisp)
+(define-caller-pattern acosh (form) :lisp)
+(define-caller-pattern atanh (form) :lisp)
+
+;;; Type Conversions and Extractions
+(define-caller-pattern float (form (:optional form)) :lisp)
+(define-caller-pattern rational (form) :lisp)
+(define-caller-pattern rationalize (form) :lisp)
+(define-caller-pattern numerator (form) :lisp)
+(define-caller-pattern denominator (form) :lisp)
+
+(define-caller-pattern floor (form (:optional form)) :lisp)
+(define-caller-pattern ceiling (form (:optional form)) :lisp)
+(define-caller-pattern truncate (form (:optional form)) :lisp)
+(define-caller-pattern round (form (:optional form)) :lisp)
+
+(define-caller-pattern mod (form form) :lisp)
+(define-caller-pattern rem (form form) :lisp)
+
+(define-caller-pattern ffloor (form (:optional form)) :lisp)
+(define-caller-pattern fceiling (form (:optional form)) :lisp)
+(define-caller-pattern ftruncate (form (:optional form)) :lisp)
+(define-caller-pattern fround (form (:optional form)) :lisp)
+
+(define-caller-pattern decode-float (form) :lisp)
+(define-caller-pattern scale-float (form form) :lisp)
+(define-caller-pattern float-radix (form) :lisp)
+(define-caller-pattern float-sign (form (:optional form)) :lisp)
+(define-caller-pattern float-digits (form) :lisp)
+(define-caller-pattern float-precision (form) :lisp)
+(define-caller-pattern integer-decode-float (form) :lisp)
+
+(define-caller-pattern complex (form (:optional form)) :lisp)
+(define-caller-pattern realpart (form) :lisp)
+(define-caller-pattern imagpart (form) :lisp)
+
+(define-caller-pattern logior ((:star form)) :lisp)
+(define-caller-pattern logxor ((:star form)) :lisp)
+(define-caller-pattern logand ((:star form)) :lisp)
+(define-caller-pattern logeqv ((:star form)) :lisp)
+
+(define-caller-pattern lognand (form form) :lisp)
+(define-caller-pattern lognor (form form) :lisp)
+(define-caller-pattern logandc1 (form form) :lisp)
+(define-caller-pattern logandc2 (form form) :lisp)
+(define-caller-pattern logorc1 (form form) :lisp)
+(define-caller-pattern logorc2 (form form) :lisp)
+
+(define-caller-pattern boole (form form form) :lisp)
+(define-variable-pattern boole-clr :lisp)
+(define-variable-pattern boole-set :lisp)
+(define-variable-pattern boole-1 :lisp)
+(define-variable-pattern boole-2 :lisp)
+(define-variable-pattern boole-c1 :lisp)
+(define-variable-pattern boole-c2 :lisp)
+(define-variable-pattern boole-and :lisp)
+(define-variable-pattern boole-ior :lisp)
+(define-variable-pattern boole-xor :lisp)
+(define-variable-pattern boole-eqv :lisp)
+(define-variable-pattern boole-nand :lisp)
+(define-variable-pattern boole-nor :lisp)
+(define-variable-pattern boole-andc1 :lisp)
+(define-variable-pattern boole-andc2 :lisp)
+(define-variable-pattern boole-orc1 :lisp)
+(define-variable-pattern boole-orc2 :lisp)
+
+(define-caller-pattern lognot (form) :lisp)
+(define-caller-pattern logtest (form form) :lisp)
+(define-caller-pattern logbitp (form form) :lisp)
+(define-caller-pattern ash (form form) :lisp)
+(define-caller-pattern logcount (form) :lisp)
+(define-caller-pattern integer-length (form) :lisp)
+
+(define-caller-pattern byte (form form) :lisp)
+(define-caller-pattern byte-size (form) :lisp)
+(define-caller-pattern byte-position (form) :lisp)
+(define-caller-pattern ldb (form form) :lisp)
+(define-caller-pattern ldb-test (form form) :lisp)
+(define-caller-pattern mask-field (form form) :lisp)
+(define-caller-pattern dpb (form form form) :lisp)
+(define-caller-pattern deposit-field (form form form) :lisp)
+
+;;; Random Numbers
+(define-caller-pattern random (form (:optional form)) :lisp)
+(define-variable-pattern *random-state* :lisp)
+(define-caller-pattern make-random-state ((:optional form)) :lisp)
+(define-caller-pattern random-state-p (form) :lisp)
+
+;;; Implementation Parameters
+(define-variable-pattern most-positive-fixnum :lisp)
+(define-variable-pattern most-negative-fixnum :lisp)
+(define-variable-pattern most-positive-short-float :lisp)
+(define-variable-pattern least-positive-short-float :lisp)
+(define-variable-pattern least-negative-short-float :lisp)
+(define-variable-pattern most-negative-short-float :lisp)
+(define-variable-pattern most-positive-single-float :lisp)
+(define-variable-pattern least-positive-single-float :lisp)
+(define-variable-pattern least-negative-single-float :lisp)
+(define-variable-pattern most-negative-single-float :lisp)
+(define-variable-pattern most-positive-double-float :lisp)
+(define-variable-pattern least-positive-double-float :lisp)
+(define-variable-pattern least-negative-double-float :lisp)
+(define-variable-pattern most-negative-double-float :lisp)
+(define-variable-pattern most-positive-long-float :lisp)
+(define-variable-pattern least-positive-long-float :lisp)
+(define-variable-pattern least-negative-long-float :lisp)
+(define-variable-pattern most-negative-long-float :lisp)
+(define-variable-pattern least-positive-normalized-short-float :lisp2)
+(define-variable-pattern least-negative-normalized-short-float :lisp2)
+(define-variable-pattern least-positive-normalized-single-float :lisp2)
+(define-variable-pattern least-negative-normalized-single-float :lisp2)
+(define-variable-pattern least-positive-normalized-double-float :lisp2)
+(define-variable-pattern least-negative-normalized-double-float :lisp2)
+(define-variable-pattern least-positive-normalized-long-float :lisp2)
+(define-variable-pattern least-negative-normalized-long-float :lisp2)
+(define-variable-pattern short-float-epsilon :lisp)
+(define-variable-pattern single-float-epsilon :lisp)
+(define-variable-pattern double-float-epsilon :lisp)
+(define-variable-pattern long-float-epsilon :lisp)
+(define-variable-pattern short-float-negative-epsilon :lisp)
+(define-variable-pattern single-float-negative-epsilon :lisp)
+(define-variable-pattern double-float-negative-epsilon :lisp)
+(define-variable-pattern long-float-negative-epsilon :lisp)
+
+;;; Characters 
+(define-variable-pattern char-code-limit :lisp)
+(define-variable-pattern char-font-limit :lisp)
+(define-variable-pattern char-bits-limit :lisp)
+(define-caller-pattern standard-char-p (form) :lisp)
+(define-caller-pattern graphic-char-p (form) :lisp)
+(define-caller-pattern string-char-p (form) :lisp)
+(define-caller-pattern alpha-char-p (form) :lisp)
+(define-caller-pattern upper-case-p (form) :lisp)
+(define-caller-pattern lower-case-p (form) :lisp)
+(define-caller-pattern both-case-p (form) :lisp)
+(define-caller-pattern digit-char-p (form (:optional form)) :lisp)
+(define-caller-pattern alphanumericp (form) :lisp)
+
+(define-caller-pattern char= ((:star form)) :lisp)
+(define-caller-pattern char/= ((:star form)) :lisp)
+(define-caller-pattern char< ((:star form)) :lisp)
+(define-caller-pattern char> ((:star form)) :lisp)
+(define-caller-pattern char<= ((:star form)) :lisp)
+(define-caller-pattern char>= ((:star form)) :lisp)
+
+(define-caller-pattern char-equal ((:star form)) :lisp)
+(define-caller-pattern char-not-equal ((:star form)) :lisp)
+(define-caller-pattern char-lessp ((:star form)) :lisp)
+(define-caller-pattern char-greaterp ((:star form)) :lisp)
+(define-caller-pattern char-not-greaterp ((:star form)) :lisp)
+(define-caller-pattern char-not-lessp ((:star form)) :lisp)
+
+(define-caller-pattern char-code (form) :lisp)
+(define-caller-pattern char-bits (form) :lisp)
+(define-caller-pattern char-font (form) :lisp)
+(define-caller-pattern code-char (form (:optional form form)) :lisp)
+(define-caller-pattern make-char (form (:optional form form)) :lisp)
+(define-caller-pattern characterp (form) :lisp)
+(define-caller-pattern char-upcase (form) :lisp)
+(define-caller-pattern char-downcase (form) :lisp)
+(define-caller-pattern digit-char (form (:optional form form)) :lisp)
+(define-caller-pattern char-int (form) :lisp)
+(define-caller-pattern int-char (form) :lisp)
+(define-caller-pattern char-name (form) :lisp)
+(define-caller-pattern name-char (form) :lisp)
+(define-variable-pattern char-control-bit :lisp)
+(define-variable-pattern char-meta-bit :lisp)
+(define-variable-pattern char-super-bit :lisp)
+(define-variable-pattern char-hyper-bit :lisp)
+(define-caller-pattern char-bit (form form) :lisp)
+(define-caller-pattern set-char-bit (form form form) :lisp)
+
+;;; Sequences
+(define-caller-pattern complement (fn) :lisp2)
+(define-caller-pattern elt (form form) :lisp)
+(define-caller-pattern subseq (form form &optional form) :lisp)
+(define-caller-pattern copy-seq (form) :lisp)
+(define-caller-pattern length (form) :lisp)
+(define-caller-pattern reverse (form) :lisp)
+(define-caller-pattern nreverse (form) :lisp)
+(define-caller-pattern make-sequence (form form &key form) :lisp)
+
+(define-caller-pattern concatenate (form (:star form)) :lisp)
+(define-caller-pattern map (form fn form (:star form)) :lisp)
+(define-caller-pattern map-into (form fn (:star form)) :lisp2)
+
+(define-caller-pattern some (fn form (:star form)) :lisp)
+(define-caller-pattern every (fn form (:star form)) :lisp)
+(define-caller-pattern notany (fn form (:star form)) :lisp)
+(define-caller-pattern notevery (fn form (:star form)) :lisp)
+
+(define-caller-pattern reduce (fn form &key (:star form)) :lisp)
+(define-caller-pattern fill (form form &key (:star form)) :lisp)
+(define-caller-pattern replace (form form &key (:star form)) :lisp)
+(define-caller-pattern remove (form form &key (:star form)) :lisp)
+(define-caller-pattern remove-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern remove-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern delete (form form &key (:star form)) :lisp)
+(define-caller-pattern delete-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern delete-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern remove-duplicates (form &key (:star form)) :lisp)
+(define-caller-pattern delete-duplicates (form &key (:star form)) :lisp)
+(define-caller-pattern substitute (form form form &key (:star form)) :lisp)
+(define-caller-pattern substitute-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern substitute-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute (form form form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubstitute-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern find (form form &key (:star form)) :lisp)
+(define-caller-pattern find-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern find-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern position (form form &key (:star form)) :lisp)
+(define-caller-pattern position-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern position-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern count (form form &key (:star form)) :lisp)
+(define-caller-pattern count-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern count-if-not (fn form &key (:star form)) :lisp)
+(define-caller-pattern mismatch (form form &key (:star form)) :lisp)
+(define-caller-pattern search (form form &key (:star form)) :lisp)
+(define-caller-pattern sort (form fn &key (:star form)) :lisp)
+(define-caller-pattern stable-sort (form fn &key (:star form)) :lisp)
+(define-caller-pattern merge (form form form fn &key (:star form)) :lisp)
+
+;;; Lists
+(define-caller-pattern car (form) :lisp)
+(define-caller-pattern cdr (form) :lisp)
+(define-caller-pattern caar (form) :lisp)
+(define-caller-pattern cadr (form) :lisp)
+(define-caller-pattern cdar (form) :lisp)
+(define-caller-pattern cddr (form) :lisp)
+(define-caller-pattern caaar (form) :lisp)
+(define-caller-pattern caadr (form) :lisp)
+(define-caller-pattern cadar (form) :lisp)
+(define-caller-pattern caddr (form) :lisp)
+(define-caller-pattern cdaar (form) :lisp)
+(define-caller-pattern cdadr (form) :lisp)
+(define-caller-pattern cddar (form) :lisp)
+(define-caller-pattern cdddr (form) :lisp)
+(define-caller-pattern caaaar (form) :lisp)
+(define-caller-pattern caaadr (form) :lisp)
+(define-caller-pattern caadar (form) :lisp)
+(define-caller-pattern caaddr (form) :lisp)
+(define-caller-pattern cadaar (form) :lisp)
+(define-caller-pattern cadadr (form) :lisp)
+(define-caller-pattern caddar (form) :lisp)
+(define-caller-pattern cadddr (form) :lisp)
+(define-caller-pattern cdaaar (form) :lisp)
+(define-caller-pattern cdaadr (form) :lisp)
+(define-caller-pattern cdadar (form) :lisp)
+(define-caller-pattern cdaddr (form) :lisp)
+(define-caller-pattern cddaar (form) :lisp)
+(define-caller-pattern cddadr (form) :lisp)
+(define-caller-pattern cdddar (form) :lisp)
+(define-caller-pattern cddddr (form) :lisp)
+
+(define-caller-pattern cons (form form) :lisp)
+(define-caller-pattern tree-equal (form form &key (:star fn)) :lisp)
+(define-caller-pattern endp (form) :lisp)
+(define-caller-pattern list-length (form) :lisp)
+(define-caller-pattern nth (form form) :lisp)
+
+(define-caller-pattern first (form) :lisp)
+(define-caller-pattern second (form) :lisp)
+(define-caller-pattern third (form) :lisp)
+(define-caller-pattern fourth (form) :lisp)
+(define-caller-pattern fifth (form) :lisp)
+(define-caller-pattern sixth (form) :lisp)
+(define-caller-pattern seventh (form) :lisp)
+(define-caller-pattern eighth (form) :lisp)
+(define-caller-pattern ninth (form) :lisp)
+(define-caller-pattern tenth (form) :lisp)
+
+(define-caller-pattern rest (form) :lisp)
+(define-caller-pattern nthcdr (form form) :lisp)
+(define-caller-pattern last (form (:optional form)) :lisp)
+(define-caller-pattern list ((:star form)) :lisp)
+(define-caller-pattern list* ((:star form)) :lisp)
+(define-caller-pattern make-list (form &key (:star form)) :lisp)
+(define-caller-pattern append ((:star form)) :lisp)
+(define-caller-pattern copy-list (form) :lisp)
+(define-caller-pattern copy-alist (form) :lisp)
+(define-caller-pattern copy-tree (form) :lisp)
+(define-caller-pattern revappend (form form) :lisp)
+(define-caller-pattern nconc ((:star form)) :lisp)
+(define-caller-pattern nreconc (form form) :lisp)
+(define-caller-pattern push (form form) :lisp)
+(define-caller-pattern pushnew (form form &key (:star form)) :lisp)
+(define-caller-pattern pop (form) :lisp)
+(define-caller-pattern butlast (form (:optional form)) :lisp)
+(define-caller-pattern nbutlast (form (:optional form)) :lisp)
+(define-caller-pattern ldiff (form form) :lisp)
+(define-caller-pattern rplaca (form form) :lisp)
+(define-caller-pattern rplacd (form form) :lisp)
+
+(define-caller-pattern subst (form form form &key (:star form)) :lisp)
+(define-caller-pattern subst-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern subst-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubst (form form form &key (:star form)) :lisp)
+(define-caller-pattern nsubst-if (form fn form &key (:star form)) :lisp)
+(define-caller-pattern nsubst-if-not (form fn form &key (:star form)) :lisp)
+(define-caller-pattern sublis (form form &key (:star form)) :lisp)
+(define-caller-pattern nsublis (form form &key (:star form)) :lisp)
+(define-caller-pattern member (form form &key (:star form)) :lisp)
+(define-caller-pattern member-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern member-if-not (fn form &key (:star form)) :lisp)
+
+(define-caller-pattern tailp (form form) :lisp)
+(define-caller-pattern adjoin (form form &key (:star form)) :lisp)
+(define-caller-pattern union (form form &key (:star form)) :lisp)
+(define-caller-pattern nunion (form form &key (:star form)) :lisp)
+(define-caller-pattern intersection (form form &key (:star form)) :lisp)
+(define-caller-pattern nintersection (form form &key (:star form)) :lisp)
+(define-caller-pattern set-difference (form form &key (:star form)) :lisp)
+(define-caller-pattern nset-difference (form form &key (:star form)) :lisp)
+(define-caller-pattern set-exclusive-or (form form &key (:star form)) :lisp)
+(define-caller-pattern nset-exclusive-or (form form &key (:star form)) :lisp)
+(define-caller-pattern subsetp (form form &key (:star form)) :lisp)
+
+(define-caller-pattern acons (form form form) :lisp)
+(define-caller-pattern pairlis (form form (:optional form)) :lisp)
+(define-caller-pattern assoc (form form &key (:star form)) :lisp)
+(define-caller-pattern assoc-if (fn form) :lisp)
+(define-caller-pattern assoc-if-not (fn form) :lisp)
+(define-caller-pattern rassoc (form form &key (:star form)) :lisp)
+(define-caller-pattern rassoc-if (fn form &key (:star form)) :lisp)
+(define-caller-pattern rassoc-if-not (fn form &key (:star form)) :lisp)
+
+;;; Hash Tables
+(define-caller-pattern make-hash-table (&key (:star form)) :lisp)
+(define-caller-pattern hash-table-p (form) :lisp)
+(define-caller-pattern gethash (form form (:optional form)) :lisp)
+(define-caller-pattern remhash (form form) :lisp)
+(define-caller-pattern maphash (fn form) :lisp)
+(define-caller-pattern clrhash (form) :lisp)
+(define-caller-pattern hash-table-count (form) :lisp)
+(define-caller-pattern with-hash-table-iterator
+  ((name form) (:star form)) :lisp2)
+(define-caller-pattern hash-table-rehash-size (form) :lisp2)
+(define-caller-pattern hash-table-rehash-threshold (form) :lisp2)
+(define-caller-pattern hash-table-size (form) :lisp2)
+(define-caller-pattern hash-table-test (form) :lisp2)
+(define-caller-pattern sxhash (form) :lisp)
+
+;;; Arrays
+(define-caller-pattern make-array (form &key (:star form)) :lisp)
+(define-variable-pattern array-rank-limit :lisp)
+(define-variable-pattern array-dimension-limit :lisp)
+(define-variable-pattern array-total-size-limit :lisp)
+(define-caller-pattern vector ((:star form)) :lisp)
+(define-caller-pattern aref (form (:star form)) :lisp)
+(define-caller-pattern svref (form form) :lisp)
+(define-caller-pattern array-element-type (form) :lisp)
+(define-caller-pattern array-rank (form) :lisp)
+(define-caller-pattern array-dimension (form form) :lisp)
+(define-caller-pattern array-dimensions (form) :lisp)
+(define-caller-pattern array-total-size (form) :lisp)
+(define-caller-pattern array-in-bounds-p (form (:star form)) :lisp)
+(define-caller-pattern array-row-major-index (form (:star form)) :lisp)
+(define-caller-pattern row-major-aref (form form) :lisp2)
+(define-caller-pattern adjustable-array-p (form) :lisp)
+
+(define-caller-pattern bit (form (:star form)) :lisp)
+(define-caller-pattern sbit (form (:star form)) :lisp)
+
+(define-caller-pattern bit-and (form form (:optional form)) :lisp)
+(define-caller-pattern bit-ior (form form (:optional form)) :lisp)
+(define-caller-pattern bit-xor (form form (:optional form)) :lisp)
+(define-caller-pattern bit-eqv (form form (:optional form)) :lisp)
+(define-caller-pattern bit-nand (form form (:optional form)) :lisp)
+(define-caller-pattern bit-nor (form form (:optional form)) :lisp)
+(define-caller-pattern bit-andc1 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-andc2 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-orc1 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-orc2 (form form (:optional form)) :lisp)
+(define-caller-pattern bit-not (form (:optional form)) :lisp)
+
+(define-caller-pattern array-has-fill-pointer-p (form) :lisp)
+(define-caller-pattern fill-pointer (form) :lisp)
+(define-caller-pattern vector-push (form form) :lisp)
+(define-caller-pattern vector-push-extend (form form (:optional form)) :lisp)
+(define-caller-pattern vector-pop (form) :lisp)
+(define-caller-pattern adjust-array (form form &key (:star form)) :lisp)
+
+;;; Strings
+(define-caller-pattern char (form form) :lisp)
+(define-caller-pattern schar (form form) :lisp)
+(define-caller-pattern string= (form form &key (:star form)) :lisp)
+(define-caller-pattern string-equal (form form &key (:star form)) :lisp)
+(define-caller-pattern string< (form form &key (:star form)) :lisp)
+(define-caller-pattern string> (form form &key (:star form)) :lisp)
+(define-caller-pattern string<= (form form &key (:star form)) :lisp)
+(define-caller-pattern string>= (form form &key (:star form)) :lisp)
+(define-caller-pattern string/= (form form &key (:star form)) :lisp)
+(define-caller-pattern string-lessp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-greaterp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-greaterp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-lessp (form form &key (:star form)) :lisp)
+(define-caller-pattern string-not-equal (form form &key (:star form)) :lisp)
+
+(define-caller-pattern make-string (form &key (:star form)) :lisp)
+(define-caller-pattern string-trim (form form) :lisp)
+(define-caller-pattern string-left-trim (form form) :lisp)
+(define-caller-pattern string-right-trim (form form) :lisp)
+(define-caller-pattern string-upcase (form &key (:star form)) :lisp)
+(define-caller-pattern string-downcase (form &key (:star form)) :lisp)
+(define-caller-pattern string-capitalize (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-upcase (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-downcase (form &key (:star form)) :lisp)
+(define-caller-pattern nstring-capitalize (form &key (:star form)) :lisp)
+(define-caller-pattern string (form) :lisp)
+
+;;; Structures
+(define-caller-pattern defstruct 
+  ((:or name (name (:rest :ignore)))
+   (:optional documentation-string)
+   (:plus :ignore))
+  :lisp)
+
+;;; The Evaluator
+(define-caller-pattern eval (form) :lisp)
+(define-variable-pattern *evalhook* :lisp)
+(define-variable-pattern *applyhook* :lisp)
+(define-caller-pattern evalhook (form fn fn &optional :ignore) :lisp)
+(define-caller-pattern applyhook (fn form fn fn &optional :ignore) :lisp)
+(define-caller-pattern constantp (form) :lisp)
+
+;;; Streams
+(define-variable-pattern *standard-input* :lisp)
+(define-variable-pattern *standard-output* :lisp)
+(define-variable-pattern *error-output* :lisp)
+(define-variable-pattern *query-io* :lisp)
+(define-variable-pattern *debug-io* :lisp)
+(define-variable-pattern *terminal-io* :lisp)
+(define-variable-pattern *trace-output* :lisp)
+(define-caller-pattern make-synonym-stream (symbol) :lisp)
+(define-caller-pattern make-broadcast-stream ((:star form)) :lisp)
+(define-caller-pattern make-concatenated-stream ((:star form)) :lisp)
+(define-caller-pattern make-two-way-stream (form form) :lisp)
+(define-caller-pattern make-echo-stream (form form) :lisp)
+(define-caller-pattern make-string-input-stream (form &optional form form) :lisp) 
+(define-caller-pattern make-string-output-stream (&key (:star form)) :lisp)
+(define-caller-pattern get-output-stream-string (form) :lisp)
+
+(define-caller-pattern with-open-stream
+  ((var form)
+   (:star declaration)
+   (:star form))
+  :lisp)
+
+(define-caller-pattern with-input-from-string
+  ((var form &key (:star form))
+   (:star declaration)
+   (:star form))
+  :lisp)
+
+(define-caller-pattern with-output-to-string
+  ((var (:optional form))
+   (:star declaration)
+   (:star form))
+  :lisp)
+(define-caller-pattern streamp (form) :lisp)
+(define-caller-pattern open-stream-p (form) :lisp2)
+(define-caller-pattern input-stream-p (form) :lisp)
+(define-caller-pattern output-stream-p (form) :lisp)
+(define-caller-pattern stream-element-type (form) :lisp)
+(define-caller-pattern close (form (:rest :ignore)) :lisp)
+(define-caller-pattern broadcast-stream-streams (form) :lisp2)
+(define-caller-pattern concatenated-stream-streams (form) :lisp2)
+(define-caller-pattern echo-stream-input-stream (form) :lisp2)
+(define-caller-pattern echo-stream-output-stream (form) :lisp2)
+(define-caller-pattern synonym-stream-symbol (form) :lisp2)
+(define-caller-pattern two-way-stream-input-stream (form) :lisp2)
+(define-caller-pattern two-way-stream-output-stream (form) :lisp2)
+(define-caller-pattern interactive-stream-p (form) :lisp2)
+(define-caller-pattern stream-external-format (form) :lisp2)
+
+;;; Reader
+(define-variable-pattern *read-base* :lisp)
+(define-variable-pattern *read-suppress* :lisp)
+(define-variable-pattern *read-eval* :lisp2)
+(define-variable-pattern *readtable* :lisp)
+(define-caller-pattern copy-readtable (&optional form form) :lisp)
+(define-caller-pattern readtablep (form) :lisp)
+(define-caller-pattern set-syntax-from-char (form form &optional form form) :lisp)
+(define-caller-pattern set-macro-character (form fn &optional form) :lisp)
+(define-caller-pattern get-macro-character (form (:optional form)) :lisp)
+(define-caller-pattern make-dispatch-macro-character (form &optional form form)
+  :lisp)
+(define-caller-pattern set-dispatch-macro-character
+  (form form fn (:optional form)) :lisp)
+(define-caller-pattern get-dispatch-macro-character
+  (form form (:optional form)) :lisp)
+(define-caller-pattern readtable-case (form) :lisp2)
+(define-variable-pattern *print-readably* :lisp2)
+(define-variable-pattern *print-escape* :lisp)
+(define-variable-pattern *print-pretty* :lisp)
+(define-variable-pattern *print-circle* :lisp)
+(define-variable-pattern *print-base* :lisp)
+(define-variable-pattern *print-radix* :lisp)
+(define-variable-pattern *print-case* :lisp)
+(define-variable-pattern *print-gensym* :lisp)
+(define-variable-pattern *print-level* :lisp)
+(define-variable-pattern *print-length* :lisp)
+(define-variable-pattern *print-array* :lisp)
+(define-caller-pattern with-standard-io-syntax 
+  ((:star declaration)
+   (:star form))
+  :lisp2)
+
+(define-caller-pattern read (&optional form form form form) :lisp)
+(define-variable-pattern *read-default-float-format* :lisp)
+(define-caller-pattern read-preserving-whitespace
+  (&optional form form form form) :lisp)
+(define-caller-pattern read-delimited-list (form &optional form form) :lisp)
+(define-caller-pattern read-line (&optional form form form form) :lisp)
+(define-caller-pattern read-char (&optional form form form form) :lisp)
+(define-caller-pattern unread-char (form (:optional form)) :lisp)
+(define-caller-pattern peek-char (&optional form form form form) :lisp)
+(define-caller-pattern listen ((:optional form)) :lisp)
+(define-caller-pattern read-char-no-hang ((:star form)) :lisp)
+(define-caller-pattern clear-input ((:optional form)) :lisp)
+(define-caller-pattern read-from-string (form (:star form)) :lisp)
+(define-caller-pattern parse-integer (form &rest :ignore) :lisp)
+(define-caller-pattern read-byte ((:star form)) :lisp)
+
+(define-caller-pattern write (form &key (:star form)) :lisp)
+(define-caller-pattern prin1 (form (:optional form)) :lisp)
+(define-caller-pattern print (form (:optional form)) :lisp)
+(define-caller-pattern pprint (form (:optional form)) :lisp)
+(define-caller-pattern princ (form (:optional form)) :lisp)
+(define-caller-pattern write-to-string (form &key (:star form)) :lisp)
+(define-caller-pattern prin1-to-string (form) :lisp)
+(define-caller-pattern princ-to-string (form) :lisp)
+(define-caller-pattern write-char (form (:optional form)) :lisp)
+(define-caller-pattern write-string (form &optional form &key (:star form)) :lisp)
+(define-caller-pattern write-line (form &optional form &key (:star form)) :lisp)
+(define-caller-pattern terpri ((:optional form)) :lisp)
+(define-caller-pattern fresh-line ((:optional form)) :lisp)
+(define-caller-pattern finish-output ((:optional form)) :lisp)
+(define-caller-pattern force-output ((:optional form)) :lisp)
+(define-caller-pattern clear-output ((:optional form)) :lisp)
+(define-caller-pattern print-unreadable-object 
+  ((form form &key (:star form))
+   (:star declaration)
+   (:star form))
+  :lisp2)
+(define-caller-pattern write-byte (form form) :lisp)
+(define-caller-pattern format
+  (destination
+   control-string
+   (:rest format-arguments))
+  :lisp)
+
+(define-caller-pattern y-or-n-p (control-string (:star form)) :lisp)
+(define-caller-pattern yes-or-no-p (control-string (:star form)) :lisp)
+
+;;; Pathnames
+(define-caller-pattern wild-pathname-p (form &optional form) :lisp2)
+(define-caller-pattern pathname-match-p (form form) :lisp2)
+(define-caller-pattern translate-pathname (form form form &key (:star form))
+  :lisp2)
+
+(define-caller-pattern logical-pathname (form) :lisp2)
+(define-caller-pattern translate-logical-pathname (form &key (:star form)) :lisp2)
+(define-caller-pattern logical-pathname-translations (form) :lisp2)
+(define-caller-pattern load-logical-pathname-translations (form) :lisp2)
+(define-caller-pattern compile-file-pathname (form &key form) :lisp2)
+
+(define-caller-pattern pathname (form) :lisp)
+(define-caller-pattern truename (form) :lisp)
+(define-caller-pattern parse-namestring ((:star form)) :lisp)
+(define-caller-pattern merge-pathnames ((:star form)) :lisp)
+(define-variable-pattern *default-pathname-defaults* :lisp)
+(define-caller-pattern make-pathname ((:star form)) :lisp)
+(define-caller-pattern pathnamep (form) :lisp)
+(define-caller-pattern pathname-host (form) :lisp)
+(define-caller-pattern pathname-device (form) :lisp)
+(define-caller-pattern pathname-directory (form) :lisp)
+(define-caller-pattern pathname-name (form) :lisp)
+(define-caller-pattern pathname-type (form) :lisp)
+(define-caller-pattern pathname-version (form) :lisp)
+(define-caller-pattern namestring (form) :lisp)
+(define-caller-pattern file-namestring (form) :lisp)
+(define-caller-pattern directory-namestring (form) :lisp)
+(define-caller-pattern host-namestring (form) :lisp)
+(define-caller-pattern enough-namestring (form (:optional form)) :lisp)
+(define-caller-pattern user-homedir-pathname (&optional form) :lisp)
+(define-caller-pattern open (form &key (:star form)) :lisp)
+(define-caller-pattern with-open-file
+  ((var form (:rest :ignore))
+   (:star declaration)
+   (:star form))
+ :lisp)
+
+(define-caller-pattern rename-file (form form) :lisp)
+(define-caller-pattern delete-file (form) :lisp)
+(define-caller-pattern probe-file (form) :lisp)
+(define-caller-pattern file-write-date (form) :lisp)
+(define-caller-pattern file-author (form) :lisp)
+(define-caller-pattern file-position (form (:optional form)) :lisp)
+(define-caller-pattern file-length (form) :lisp)
+(define-caller-pattern file-string-length (form form) :lisp2)
+(define-caller-pattern load (form &key (:star form)) :lisp)
+(define-variable-pattern *load-verbose* :lisp)
+(define-variable-pattern *load-print* :lisp2)
+(define-variable-pattern *load-pathname* :lisp2)
+(define-variable-pattern *load-truename* :lisp2)
+(define-caller-pattern make-load-form (form) :lisp2)
+(define-caller-pattern make-load-form-saving-slots (form &optional form)
+  :lisp2)
+(define-caller-pattern directory (form &key (:star form)) :lisp)
+
+;;; Errors
+(define-caller-pattern error (form (:star form)) :lisp)
+(define-caller-pattern cerror (form form (:star form)) :lisp)
+(define-caller-pattern warn (form (:star form)) :lisp)
+(define-variable-pattern *break-on-warnings* :lisp)
+(define-caller-pattern break (&optional form (:star form)) :lisp)
+(define-caller-pattern check-type (form form (:optional form)) :lisp)
+(define-caller-pattern assert 
+  (form
+   (:optional ((:star var))
+	      (:optional form (:star form)))) 
+  :lisp)
+(define-caller-pattern etypecase (form (:star (symbol (:star form)))) :lisp)
+(define-caller-pattern ctypecase (form (:star (symbol (:star form)))) :lisp)
+(define-caller-pattern ecase
+  (form
+   (:star ((:or symbol ((:star symbol)))
+	   (:star form))))
+  :lisp)
+(define-caller-pattern ccase 
+  (form
+   (:star ((:or symbol ((:star symbol)))
+	   (:star form))))
+  :lisp)
+
+;;; The Compiler
+(define-caller-pattern compile (form (:optional form)) :lisp)
+(define-caller-pattern compile-file (form &key (:star form)) :lisp)
+(define-variable-pattern *compile-verbose* :lisp2)
+(define-variable-pattern *compile-print* :lisp2)
+(define-variable-pattern *compile-file-pathname* :lisp2)
+(define-variable-pattern *compile-file-truename* :lisp2)
+(define-caller-pattern load-time-value (form (:optional form)) :lisp2)
+(define-caller-pattern disassemble (form) :lisp)
+(define-caller-pattern function-lambda-expression (fn) :lisp2)
+(define-caller-pattern with-compilation-unit (((:star :ignore)) (:star form)) 
+  :lisp2)
+
+;;; Documentation
+(define-caller-pattern documentation (form form) :lisp)
+(define-caller-pattern trace ((:star form)) :lisp)
+(define-caller-pattern untrace ((:star form)) :lisp)
+(define-caller-pattern step (form) :lisp)
+(define-caller-pattern time (form) :lisp)
+(define-caller-pattern describe (form &optional form) :lisp)
+(define-caller-pattern describe-object (form &optional form) :lisp2)
+(define-caller-pattern inspect (form) :lisp)
+(define-caller-pattern room ((:optional form)) :lisp)
+(define-caller-pattern ed ((:optional form)) :lisp)
+(define-caller-pattern dribble ((:optional form)) :lisp)
+(define-caller-pattern apropos (form (:optional form)) :lisp)
+(define-caller-pattern apropos-list (form (:optional form)) :lisp)
+(define-caller-pattern get-decoded-time () :lisp)
+(define-caller-pattern get-universal-time () :lisp)
+(define-caller-pattern decode-universal-time (form &optional form) :lisp)
+(define-caller-pattern encode-universal-time 
+  (form form form form form form &optional form) :lisp)
+(define-caller-pattern get-internal-run-time () :lisp)
+(define-caller-pattern get-internal-real-time () :lisp)
+(define-caller-pattern sleep (form) :lisp)
+
+(define-caller-pattern lisp-implementation-type () :lisp)
+(define-caller-pattern lisp-implementation-version () :lisp)
+(define-caller-pattern machine-type () :lisp)
+(define-caller-pattern machine-version () :lisp)
+(define-caller-pattern machine-instance () :lisp)
+(define-caller-pattern software-type () :lisp)
+(define-caller-pattern software-version () :lisp)
+(define-caller-pattern short-site-name () :lisp)
+(define-caller-pattern long-site-name () :lisp)
+(define-variable-pattern *features* :lisp)
+
+(define-caller-pattern identity (form) :lisp)
+
+;;; Pretty Printing
+(define-variable-pattern *print-pprint-dispatch* :lisp2)
+(define-variable-pattern *print-right-margin* :lisp2)
+(define-variable-pattern *print-miser-width* :lisp2)
+(define-variable-pattern *print-lines* :lisp2)
+(define-caller-pattern pprint-newline (form &optional form) :lisp2)
+(define-caller-pattern pprint-logical-block
+  ((var form &key (:star form))
+   (:star form))
+  :lisp2)
+(define-caller-pattern pprint-exit-if-list-exhausted () :lisp2)
+(define-caller-pattern pprint-pop () :lisp2)
+(define-caller-pattern pprint-indent (form form &optional form) :lisp2)
+(define-caller-pattern pprint-tab (form form form &optional form) :lisp2)
+(define-caller-pattern pprint-fill (form form &optional form form) :lisp2)
+(define-caller-pattern pprint-linear (form form &optional form form) :lisp2)
+(define-caller-pattern pprint-tabular (form form &optional form form form) :lisp2)
+(define-caller-pattern formatter (control-string) :lisp2)
+(define-caller-pattern copy-pprint-dispatch (&optional form) :lisp2)
+(define-caller-pattern pprint-dispatch (form &optional form) :lisp2)
+(define-caller-pattern set-pprint-dispatch (form form &optional form form)
+  :lisp2)
+
+;;; CLOS
+(define-caller-pattern add-method (fn form) :lisp2)
+(define-caller-pattern call-method (form form) :lisp2)
+(define-caller-pattern call-next-method ((:star form)) :lisp2)
+(define-caller-pattern change-class (form form) :lisp2)
+(define-caller-pattern class-name (form) :lisp2)
+(define-caller-pattern class-of (form) :lisp2)
+(define-caller-pattern compute-applicable-methods (fn (:star form)) :lisp2)
+(define-caller-pattern defclass (name &rest :ignore) :lisp2)
+(define-caller-pattern defgeneric (name lambda-list &rest :ignore) :lisp2)
+(define-caller-pattern define-method-combination 
+  (name lambda-list ((:star :ignore))
+	(:optional ((:eq :arguments) :ignore))
+	(:optional ((:eq :generic-function) :ignore))
+	(:star (:or declaration documentation-string))
+	(:star form))
+  :lisp2)
+(define-caller-pattern defmethod 
+  (name (:star symbol) lambda-list
+	(:star (:or declaration documentation-string))
+	(:star form))
+  :lisp2)
+(define-caller-pattern ensure-generic-function (name &key (:star form)) :lisp2)
+(define-caller-pattern find-class (form &optional form form) :lisp2)
+(define-caller-pattern find-method (fn &rest :ignore) :lisp2)
+(define-caller-pattern function-keywords (&rest :ignore) :lisp2)
+(define-caller-pattern generic-flet (((:star (name lambda-list))) (:star form))
+  :lisp2)
+(define-caller-pattern generic-labels 
+  (((:star (name lambda-list))) (:star form))
+  :lisp2)
+(define-caller-pattern generic-function (lambda-list) :lisp2)
+(define-caller-pattern initialize-instance (form &key (:star form)) :lisp2)
+(define-caller-pattern invalid-method-error (fn form (:star form)) :lisp2)
+(define-caller-pattern make-instance (fn (:star form)) :lisp2)
+(define-caller-pattern make-instances-obsolete (fn) :lisp2)
+(define-caller-pattern method-combination-error (form (:star form)) :lisp2)
+(define-caller-pattern method-qualifiers (fn) :lisp2)
+(define-caller-pattern next-method-p () :lisp2)
+(define-caller-pattern no-applicable-method (fn (:star form)) :lisp2)
+(define-caller-pattern no-next-method (fn (:star form)) :lisp2)
+(define-caller-pattern print-object (form form) :lisp2)
+(define-caller-pattern reinitialize-instance (form (:star form)) :lisp2)
+(define-caller-pattern remove-method (fn form) :lisp2)
+(define-caller-pattern shared-initialize (form form (:star form)) :lisp2)
+(define-caller-pattern slot-boundp (form form) :lisp2)
+(define-caller-pattern slot-exists-p (form form) :lisp2)
+(define-caller-pattern slot-makeunbound (form form) :lisp2)
+(define-caller-pattern slot-missing (fn form form form &optional form) :lisp2)
+(define-caller-pattern slot-unbound (fn form form) :lisp2)
+(define-caller-pattern slot-value (form form) :lisp2)
+(define-caller-pattern update-instance-for-different-class 
+  (form form (:star form)) :lisp2)
+(define-caller-pattern update-instance-for-redefined-class 
+  (form form (:star form)) :lisp2)
+(define-caller-pattern with-accessors
+  (((:star :ignore)) form
+   (:star declaration)
+   (:star form))
+  :lisp2)
+(define-caller-pattern with-added-methods
+  ((name lambda-list) form
+   (:star form))
+  :lisp2)
+(define-caller-pattern with-slots
+  (((:star :ignore)) form
+   (:star declaration)
+   (:star form))
+  :lisp2)
+
+;;; Conditions
+(define-caller-pattern signal (form (:star form)) :lisp2)
+(define-variable-pattern *break-on-signals* :lisp2)
+(define-caller-pattern handler-case (form (:star (form ((:optional var))
+						       (:star form))))
+  :lisp2)
+(define-caller-pattern ignore-errors ((:star form)) :lisp2)
+(define-caller-pattern handler-bind (((:star (form form)))
+				     (:star form))
+  :lisp2)
+(define-caller-pattern define-condition (name &rest :ignore) :lisp2)
+(define-caller-pattern make-condition (form &rest :ignore) :lisp2)
+(define-caller-pattern with-simple-restart
+  ((name form (:star form)) (:star form)) :lisp2)
+(define-caller-pattern restart-case 
+  (form
+   (:star (form form (:star form))))
+  :lisp2)
+(define-caller-pattern restart-bind
+  (((:star (name fn &key (:star form))))
+   (:star form))
+  :lisp2)
+(define-caller-pattern with-condition-restarts
+  (form form
+	(:star declaration)
+	(:star form))
+  :lisp2)
+(define-caller-pattern compute-restarts (&optional form) :lisp2)
+(define-caller-pattern restart-name (form) :lisp2)
+(define-caller-pattern find-restart (form &optional form) :lisp2)
+(define-caller-pattern invoke-restart (form (:star form)) :lisp2)
+(define-caller-pattern invoke-restart-interactively (form) :lisp2)
+(define-caller-pattern abort (&optional form) :lisp2)
+(define-caller-pattern continue (&optional form) :lisp2)
+(define-caller-pattern muffle-warning (&optional form) :lisp2)
+(define-caller-pattern store-value (form &optional form) :lisp2)
+(define-caller-pattern use-value (form &optional form) :lisp2)
+(define-caller-pattern invoke-debugger (form) :lisp2)
+(define-variable-pattern *debugger-hook* :lisp2)
+(define-caller-pattern simple-condition-format-string (form) :lisp2)
+(define-caller-pattern simple-condition-format-arguments (form) :lisp2)
+(define-caller-pattern type-error-datum (form) :lisp2)
+(define-caller-pattern type-error-expected-type (form) :lisp2)
+(define-caller-pattern package-error-package (form) :lisp2)
+(define-caller-pattern stream-error-stream (form) :lisp2)
+(define-caller-pattern file-error-pathname (form) :lisp2)
+(define-caller-pattern cell-error-name (form) :lisp2)
+(define-caller-pattern arithmetic-error-operation (form) :lisp2)
+(define-caller-pattern arithmetic-error-operands (form) :lisp2)
+
+;;; For ZetaLisp Flavors
+(define-caller-pattern send (form fn (:star form)) :flavors)




More information about the Bknr-cvs mailing list