Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'master' of ../swank-clojure.technomancy

  • Loading branch information...
commit 35436c737d10f2c057b490848add5c5c70866992 2 parents e2cec66 + 08972e8
@blais blais authored
Showing with 23,250 additions and 466 deletions.
  1. +4 −1 .gitignore
  2. +0 −31 NEWS
  3. +71 −0 NEWS.md
  4. +239 −83 README.md
  5. +19 −0 lein-swank/README.md
  6. +3 −0  lein-swank/project.clj
  7. +4 −0 lein-swank/resources/swank_elisp_payloads.clj
  8. +60 −0 lein-swank/src/leiningen/jack_in.clj
  9. +74 −0 lein-swank/src/leiningen/swank.clj
  10. +16 −0 lein-swank/src/leiningen/swank_wrap.clj
  11. +37 −0 lein-swank/src/swank/payload/slime-compile-presave.el
  12. +12 −0 lein-swank/src/swank/payload/slime-eldoc.el
  13. +18 −0 lein-swank/src/swank/payload/slime-frame-colors.el
  14. +1,854 −0 lein-swank/src/swank/payload/slime-repl.el
  15. +9,056 −0 lein-swank/src/swank/payload/slime.el
  16. +9 −5 project.clj
  17. +4 −0 resources/swank_elisp_payloads.clj
  18. +0 −30 src/leiningen/swank.clj
  19. +14 −2 src/swank/cdt.clj
  20. +233 −67 src/swank/commands/basic.clj
  21. +8 −8 src/swank/commands/completion.clj
  22. +49 −48 src/swank/commands/inspector.clj
  23. +3 −2 src/swank/commands/xref.clj
  24. +159 −33 src/swank/core.clj
  25. +47 −12 src/swank/core/cdt_backends.clj
  26. +54 −2 src/swank/core/cdt_utils.clj
  27. +4 −2 src/swank/core/protocol.clj
  28. +31 −23 src/swank/core/server.clj
  29. +2 −0  src/swank/dev.clj
  30. +37 −0 src/swank/payload/slime-compile-presave.el
  31. +12 −0 src/swank/payload/slime-eldoc.el
  32. +18 −0 src/swank/payload/slime-frame-colors.el
  33. +1,854 −0 src/swank/payload/slime-repl.el
  34. +9,056 −0 src/swank/payload/slime.el
  35. +48 −47 src/swank/rpc.clj
  36. +58 −49 src/swank/swank.clj
  37. +3 −1 src/swank/util.clj
  38. +4 −1 src/swank/util/class_browse.clj
  39. +17 −0 src/swank/util/clj_stacktrace_compat.clj
  40. +3 −2 src/swank/util/concurrent/thread.clj
  41. +10 −9 src/swank/util/io.clj
  42. +6 −2 src/swank/util/net/sockets.clj
  43. +27 −3 src/swank/util/sys.clj
  44. BIN  test/data/test.jar
  45. +1 −1  test/swank/test_swank/commands/basic.clj
  46. +10 −0 test/swank/test_swank/util/class_browse.clj
  47. +2 −2 test/swank/test_swank/util/net/sockets.clj
View
5 .gitignore
@@ -1,5 +1,8 @@
classes/
lib/
multi-lib/
-swank-clojure*jar
+*jar
pom.xml
+.lein-failures
+.lein-deps-sum
+/lein-swank/.lein-plugins/checksum
View
31 NEWS
@@ -1,31 +0,0 @@
-Swank Clojure NEWS -- history of user-visible changes
-
-= 1.2.0 / 2010-05-15
-
-* Move lein-swank plugin to be bundled with swank-clojure.
-
-* Support M-x slime-who-calls. List all the callers of a given function.
-
-* Add swank.core/break.
-
-* Support slime-pprint-eval-last-expression.
-
-* Improve support for trunk slime.
-
-* Completion for static Java members.
-
-* Show causes of exceptions in debugger.
-
-* Preserve line numbers when compiling a region/defn.
-
-* Relicense to the EPL (same as Clojure).
-
-* Better compatibility with Clojure 1.2.
-
-= 1.1.0 / 2010-01-01
-
-* A whole mess of stuff!
-
-= 1.0.0 / 2009-11-10
-
-* First versioned release.
View
71 NEWS.md
@@ -0,0 +1,71 @@
+# Swank Clojure NEWS -- history of user-visible changes
+
+## 1.5.0 / ???
+
+* Spun lein-swank off into its own project for `:plugins` compatibility.
+* Add support for clearing existing namespace with load-file.
+
+## 1.4.1 / 2012-03-23
+
+* Add stop-server functionality.
+
+## 1.4.0 / 2012-01-27
+
+* Added CDT debugger.
+* Support jacking into remote machines over tramp.
+
+## 1.3.4 / 2011-12-27
+
+* Integrate clj-stacktrace with slime debugger buffers.
+* Inspector now supports showing constructors and interfaces on classes.
+* Make `clojure-jack-in` more forgiving of boot-time lein output.
+
+## 1.3.3 / 2011-10-04
+
+* Load elisp payloads from various jars during jack-in.
+* Add support for \*out\* root value going to repl buffer.
+* Check for $PORT as default port.
+* Byte-compile elisp source to disk rather than spitting afresh every time.
+
+## 1.3.2 / 2011-07-12
+
+* Cause the Swank server to explicitly block.
+
+## 1.3.1 / 2011-05-16
+
+* Allow for customized announce message.
+* Add lein jack-in task.
+* Support :repl-init option from project.clj.
+
+## 1.3.0 / 2011-03-22
+
+* Add Clojure 1.3 support.
+* M-x slime-load-file (C-c C-l) causes full :reload-all.
+* Better support for running on the bootstrap classpath.
+* Get encoding from locale.
+* Bind to localhost by default rather than 0.0.0.0.
+* Include Leiningen shell wrapper for standalone sessions.
+* Support completion on class names.
+
+## 1.2.0 / 2010-05-15
+
+* Move lein-swank plugin to be bundled with swank-clojure.
+* Support M-x slime-who-calls. List all the callers of a given function.
+* Add swank.core/break.
+* Support slime-pprint-eval-last-expression.
+* Improve support for trunk slime.
+* Completion for static Java members.
+* Show causes of exceptions in debugger.
+* Preserve line numbers when compiling a region/defn.
+* Relicense to the EPL (same as Clojure).
+* Better compatibility with Clojure 1.2.
+
+## 1.1.0 / 2010-01-01
+
+* Added slime-list-threads, killing threads.
+* Dim irrelevant sldb stack frames.
+* Emacs 22 support.
+
+## 1.0.0 / 2009-11-10
+
+* First versioned release.
View
322 README.md
@@ -1,66 +1,142 @@
# Swank Clojure
[Swank Clojure](http://github.com/technomancy/swank-clojure) is a
-server that allows [SLIME](http://common-lisp.net/project/slime/) (the
-Superior Lisp Interaction Mode for Emacs) to connect to Clojure
-projects. To use it you must launch a swank server, then connect to it
-from within Emacs.
+server that allows SLIME (the Superior Lisp Interaction Mode for
+Emacs) to connect to Clojure projects.
## Usage
+The simplest way is to just "jack in" from an existing project
+using [Leiningen](http://github.com/technomancy/leiningen):
+
+* Install `clojure-mode` either from
+ [Marmalade](http://marmalade-repo.org) or from
+ [git](http://github.com/technomancy/clojure-mode).
+* Add `[lein-swank "1.4.4"]` to the `:plugins` section of either
+ `project.clj` or your user profile.
+* From an Emacs buffer inside a project, invoke `M-x clojure-jack-in`
+
+If you are still using Leiningen 1.x, you will need to do
+`lein plugin install swank-clojure 1.4.2` instead.
+
+That's all it takes; there are no extra install steps beyond
+`clojure-mode` on the Emacs side and the `swank-clojure` plugin on the
+Leiningen side. In particular, be sure you **don't have any other
+versions of SLIME loaded**; see "Troubleshooting" below.
+
+## SLIME Commands
+
+Commonly-used SLIME commands:
+
+* **M-.**: Jump to the definition of a var
+* **M-TAB** or **C-c TAB**: Autocomplete symbol at point
+* **C-x C-e**: Eval the form under the point
+* **C-c C-k**: Compile the current buffer
+* **C-c C-l**: Load current buffer and force required namespaces to reload
+* **C-M-x**: Compile the whole top-level form under the point.
+* **C-c S-i**: Inspect a value
+* **C-c C-m**: Macroexpand the call under the point
+* **C-c C-d C-d**: Look up documentation for a var
+* **C-c C-z**: Switch from a Clojure buffer to the repl buffer
+* **C-c M-p**: Switch the repl namespace to match the current buffer
+* **C-c C-w c**: List all callers of a given function
+
+Pressing "v" on a stack trace a debug buffer will jump to the file and
+line referenced by that frame if possible.
+
+Note that SLIME was designed to work with Common Lisp, which has a
+distinction between interpreted code and compiled code. Clojure has no
+such distinction, so the load-file functionality is overloaded to add
+<code>:reload-all</code> behaviour.
+
+## Alternate Usage
+
+There are other ways to use Swank for different specific
+circumstances. For each of these methods you will have to install the
+slime and slime-repl Emacs Lisp libraries manually as outlined in
+"Connecting with SLIME" below.
+
+### Standalone Server
+
If you just want a standalone swank server with no third-party
-libraries, you can just install swank-clojure using Leiningen.
+libraries, you can use the shell wrapper that Leiningen installs for
+you:
- $ lein plugin install swank-clojure 1.3.0
+ $ lein plugin install swank-clojure 1.4.2
$ ~/.lein/bin/swank-clojure
M-x slime-connect
-If you put ~/.lein/bin on your $PATH it's even more convenient.
+If you put `~/.lein/bin` on your <tt>$PATH</tt> it's even more
+convenient.
-You can also start a swank server from inside your project:
+### Manual Swank in Project
- $ lein swank # you can specify PORT and HOST optionally
+You can also start a swank server by hand from inside your project.
+You'll need to have installed using `lein plugin
+install`, then launch the server from the shell:
-Note that the lein-swank plugin now comes with Swank Clojure; it does
-not need to be specified as a separate dependency any more.
+ $ lein swank # you can specify PORT and HOST optionally
If you're using Maven, add this to your pom.xml under the
\<dependencies\> section:
+```xml
<dependency>
<groupId>swank-clojure</groupId>
<artifactId>swank-clojure</artifactId>
- <version>1.2.1</version>
+ <version>1.4.2</version>
</dependency>
+```
Then you can launch a swank server like so:
- $ mvn -o clojure:swank
+ $ mvn clojure:swank
Note that due to a bug in clojure-maven-plugin, you currently cannot
include it as a test-scoped dependency; it must be compile-scoped. You
also cannot change the port from Maven; it's hard-coded to 4005.
-Put this in your Emacs configuration to get syntax highlighting in the
-slime repl:
+### Embedding
+
+You can embed Swank Clojure in your project, start the server from
+within your own code, and connect via Emacs to that instance:
+
+```clj
+(ns my-app
+ (:require [swank.swank]))
+(swank.swank/start-server) ;; optionally takes :host/:port keyword args
+```
- (add-hook 'slime-repl-mode-hook 'clojure-mode-font-lock-setup)
+To make this work in production, swank-clojure needs to be in
+`:dependencies` in project.clj in addition to being installed
+as a user-level plugin. If you do this, you can also start the server
+directly from the `java` command-line launcher if you're using Clojure
+1.3 or newer:
+
+ $ java -cp my-project-standalone-1.0.0.jar clojure.main -m swank.swank
## Connecting with SLIME
-Install the "slime-repl" package using package.el. If you are using
-Emacs 23, it's best to get [the latest version of package.el from
-Emacs
-trunk](http://bit.ly/pkg-el). Then
-add Marmalade as an archive source:
+If you're not using the `M-x clojure-jack-in` method mentioned
+above, you'll have to install SLIME yourself. The easiest way is to
+use package.el. If you are using Emacs 24 or the
+[Emacs Starter Kit](http://github.com/technomancy/emacs-starter-kit),
+then you have it already. If not, get it
+[from Emacs's own repository](http://bit.ly/pkg-el23).
+
+Then add Marmalade as an archive source in your Emacs config:
- (add-to-list 'package-archives
- '("marmalade" . "http://marmalade-repo.org/packages/") t)
+```lisp
+(require 'package)
+(add-to-list 'package-archives
+ '("marmalade" . "http://marmalade-repo.org/packages/") t)
+(package-initialize)
+```
-Then you can do <kbd>M-x package-list-packages</kbd>. Go down to
-slime-repl and mark it with <kbd>i</kbd>. Execute the installation by
-pressing <kbd>x</kbd>.
+Evaluate that, then run <kbd>M-x package-refresh-contents</kbd> to
+pull in the latest source lists. Then you can do <kbd>M-x
+package-install</kbd> and choose <kbd>slime-repl</kbd>.
When you perform the installation, you will see warnings related to
the byte-compilation of the packages. This is **normal**; the packages
@@ -75,65 +151,145 @@ It will prompt you for your host (usually localhost) and port. It may
also warn you that your SLIME version doesn't match your Swank
version; this should be OK.
-Having old versions of SLIME either manually installed or installed
-using a system-wide package manager like apt-get may cause issues.
-
-## SLIME Commands
-
-Commonly-used SLIME commands:
-
-* **C-c TAB**: Autocomplete symbol at point
-* **C-x C-e**: Eval the form under the point
-* **C-c C-k**: Compile the current buffer
-* **C-c C-l**: Load current buffer and force dependent namespaces to reload
-* **M-.**: Jump to the definition of a var
-* **C-c S-i**: Inspect a value
-* **C-c C-m**: Macroexpand the call under the point
-* **C-c C-d C-d**: Look up documentation for a var
-* **C-c C-z**: Switch from a Clojure buffer to the repl buffer
-* **C-c M-p**: Switch the repl namespace to match the current buffer
-* **C-c C-w c**: List all callers of a given function
-
-Pressing "v" on a stack trace a debug buffer will jump to the file and
-line referenced by that frame if possible.
-
-Note that SLIME was designed to work with Common Lisp, which has a
-distinction between interpreted code and compiled code. Clojure has no
-such distinction, so the load-file functionality is overloaded to add
-<code>:reload-all</code> behaviour.
-
-## Embedding
-
-You can embed Swank Clojure in your project, start the server from
-within your own code, and connect via Emacs to that instance:
-
- (ns my-app
- (:require [swank.swank]))
- (swank.swank/start-repl) ;; optionally takes a port argument
-
-Then use M-x slime-connect to connect from within Emacs.
-
-You can also start the server directly from the "java" command-line
-launcher if you AOT-compile it and specify "swank.swank" as your main
-class.
-
-## Debug Repl
-
-For now, see [Hugo Duncan's
-blog](http://hugoduncan.org/post/2010/swank_clojure_gets_a_break_with_the_local_environment.xhtml)
-for an explanation of this excellent feature. Further documentation to come.
-
-## swank-clojure.el
-
-Previous versions of Swank Clojure bundled an Elisp library called
-swank-clojure.el that provided ways to launch your swank server from
-within your Emacs process. It's much more reliable to launch the
-server from your build tool, so this has been removed.
+To get syntax highlighting in your repl buffer, use this elisp:
+
+```lisp
+(add-hook 'slime-repl-mode-hook
+ (defun clojure-mode-slime-font-lock ()
+ (require 'clojure-mode)
+ (let (font-lock-mode)
+ (clojure-mode-font-lock-setup))))
+```
+
+To get colors in stack traces, load the elisp in
+`src/swank/payload/slime-frame-colors.el` inside Emacs and use
+`lein swank $PORT localhost :colors? true` to launch the swank server.
+
+## Troubleshooting
+
+Currently having multiple versions of swank-clojure on the classpath
+can cause issues when running `lein swank` or `lein jack-in`. It's
+recommended to not put swank-clojure in your `:dev-dependencies` but
+run `lein plugin install` to have it installed globally for all
+projects instead. This also means that people hacking on your project
+won't have to pull it in if they are not Emacs users.
+
+It's also possible for some packages to pull in old versions of
+swank-clojure transitively, so check the `lib/` directory if
+you are having issues. In particular, Incanter is known to exhibit
+this problem. Judicious use of `:exclusions` make it work:
+
+```clj
+ :dependencies [[incanter "1.2.3" :exclusions [swank-clojure]]]
+```
+
+Since swank-clojure 1.3.4, having versions of clj-stacktrace older
+than 0.2.1 in your project or user-level plugins will cause `Unable to
+resolve symbol: pst-elem-str` errors. Keep in mind that user-level
+plugins in `~/.lein/plugins` are uberjars in Leiningen 1.x, so it's
+possible that one of your plugins (such as `lein-difftest` before
+version 1.3.7) contains an old clj-stacktrace even if it doesn't have
+its own file there. Specifying a newer version should be enough if
+you're having trouble:
+
+```clj
+ :dependencies [[clj-stacktrace "0.2.4"]]
+```
+
+Having old versions of SLIME installed either manually or using a
+system-wide package manager like apt-get may cause issues. Also the
+official CVS version of SLIME is not supported; it often breaks
+compatibility with Clojure. In addition, the `slime-clj` packages are
+incompatible with swank-clojure.
+
+It's possible to have Emacs configured for both Common Lisp and
+Clojure if you defer loading of Slime until it's needed.
+[This issue](https://github.com/technomancy/swank-clojure/issues/66)
+has details on how that is done. It's not possible to have a single
+instance of Emacs connect to both though.
+
+Swank-clojure and SLIME are only tested with GNU Emacs; forks such as
+Aquamacs and XEmacs may work but are not officially supported.
+
+On Mac OS X, Emacs sessions launched from the GUI don't always respect
+your configured $PATH. If Emacs can't find `lein`, you may need to
+give it some help. The quickest way is probably to add this elisp to
+your config:
+
+```lisp
+(setenv "PATH" (shell-command-to-string "echo $PATH"))
+```
+
+When using `clojure-jack-in`, standard out for the Leiningen process
+appears in the `*swank*` buffer, but the `*out*` var gets rebound to a
+writer that is able to redirect to the `*slime-repl*` buffer. So in
+general most Clojure output will show up in your repl buffer just
+fine, but for output coming from Java libraries you may need to check
+the `*swank*` buffer.
+
+## Cygwin
+
+If you are running Emacs from Cygwin, you'll need to add the following to your
+.emacs.d/init.el file:
+
+```lisp
+(defun cyg-slime-to-lisp-translation (filename)
+ (replace-regexp-in-string "\n" ""
+ (shell-command-to-string
+ (format "cygpath.exe --windows %s" filename))))
+
+(defun cyg-lisp-to-slime-translation (filename)
+ (replace-regexp-in-string "\n" "" (shell-command-to-string
+ (format "cygpath.exe --unix %s filename"))))
+
+(setq slime-to-lisp-filename-function #'cyg-slime-to-lisp-translation)
+(setq lisp-to-slime-filename-function #'cyg-lisp-to-slime-translation)
+```
+
+This is required because the jvm runs as a normal Windows exe and uses
+Windows style paths rather than Cygwin unix style paths.
+
+## How it Works
+
+Swank Clojure is simply a server that communicates over the Slime
+protocol with an Emacs process. As such it runs in a JVM process,
+usually launched by Leiningen. Slime is a client that runs within
+Emacs to communicate with Swank. You can start the two of them
+separately as explained in "Connecting with SLIME" above, but `M-x
+clojure-jack-in` will send the elisp code for Slime to the Emacs
+process to ensure that it uses a version of Slime that is compatible
+with that version of Swank. Once the Swank server is finished loading,
+it sends a signal to Emacs to connect to it.
+
+## Debugger
+
+You can set repl-aware breakpoints using `swank.core/break`.
+For now, see
+[Hugo Duncan's blog](http://hugoduncan.org/post/2010/swank_clojure_gets_a_break_with_the_local_environment.xhtml)
+for an explanation of this excellent feature.
+
+[CDT](http://georgejahad.com/clojure/swank-cdt.html) (included in
+Swank Clojure since 1.4.0) is a more comprehensive debugging tool
+that includes support for stepping, seting breakpoints, catching
+exceptions, and eval clojure expressions in the context of the current
+lexical scope.
+
+Note that the CDT does not work with `:eval-in-leiningen` without
+extra manual configuration.
+
+## TODO
+
+* unmap-ns command
+* show method argument names in slime inspector (theoretically possible?)
+* show better metadata on functions in inspector
+* offer restarts for class/var not found exceptions (slamhound integration?)
+* add elisp payload for cdt commands
+* suppress false "warning: unabled to add tools.jar to classpath" message
## Community
-The [mailing list](http://groups.google.com/group/swank-clojure) and
-clojure channel on Freenode are the best places to bring up
+The [swank-clojure mailing list](http://groups.google.com/group/swank-clojure)
+and clojure channel on Freenode are the best places to bring up
questions/issues.
Contributions are preferred as either Github pull requests or using
@@ -146,7 +302,7 @@ either.
## License
-Copyright (C) 2008-2011 Jeffrey Chu, Phil Hagelberg, Hugo Duncan, and
+Copyright © 2008-2012 Jeffrey Chu, Phil Hagelberg, Hugo Duncan, and
contributors
Licensed under the EPL. (See the file COPYING.)
View
19 lein-swank/README.md
@@ -0,0 +1,19 @@
+# lein-swank
+
+Leiningen plugin for launching a swank server.
+
+## Usage
+
+From version 1.7.0 on, Leiningen uses a separate list for plugins
+rather than `:dev-dependencies`. If you are using Leiningen 1.6 or
+earlier, continue adding the main `swank-clojure` entry into your
+`:dev-dependencies`.
+
+Add `[lein-swank "1.4.3"]` to `:plugins` in `project.clj`.
+Then you should have access to the `swank` and `jack-in` tasks.
+
+## License
+
+Copyright © 2012 Phil Hagelberg
+
+Distributed under the Eclipse Public License, the same as Clojure.
View
3  lein-swank/project.clj
@@ -0,0 +1,3 @@
+(defproject lein-swank "1.4.4"
+ :description "A Leiningen plugin for launching a Swank server for Slime."
+ :eval-in-leiningen true)
View
4 lein-swank/resources/swank_elisp_payloads.clj
@@ -0,0 +1,4 @@
+["swank/payload/slime.el"
+ "swank/payload/slime-repl.el"
+ "swank/payload/slime-frame-colors.el"
+ "swank/payload/slime-eldoc.el"]
View
60 lein-swank/src/leiningen/jack_in.clj
@@ -0,0 +1,60 @@
+(ns leiningen.jack-in
+ (:require [clojure.java.io :as io]
+ [clojure.string :as string]
+ [leiningen.swank :as swank])
+ (:import (java.security MessageDigest)))
+
+(def ^:private payloads-file-name "swank_elisp_payloads.clj")
+
+(defn elisp-payload-files []
+ ;; TODO: this may not work with lein2 plugins
+ (->> (.getResources (.getContextClassLoader (Thread/currentThread))
+ payloads-file-name)
+ (enumeration-seq)
+ (map (comp read-string slurp))
+ (apply concat)
+ (set)))
+
+(defn hex-digest [file]
+ (format "%x" (BigInteger. 1 (.digest (MessageDigest/getInstance "SHA1")
+ (-> file io/resource slurp .getBytes)))))
+
+(defn loader [resource]
+ (let [feature (second (re-find #".*/(.*?).el$" resource))
+ checksum (subs (hex-digest resource) 0 8)
+ filename (format "%s-%s" feature checksum)
+ basename (-> (or (System/getenv "HOME")
+ (System/getProperty "user.home"))
+ (io/file ".emacs.d" "swank" filename)
+ (.getAbsolutePath)
+ (.replaceAll "\\\\" "/"))
+ elisp (str basename ".el")
+ bytecode (str basename ".elc")
+ elisp-file (io/file elisp)]
+ (when-not (.exists elisp-file)
+ (.mkdirs (.getParentFile elisp-file))
+ (with-open [r (.openStream (io/resource resource))]
+ (io/copy r elisp-file))
+ (with-open [w (io/writer elisp-file :append true)]
+ (.write w (format "\n(provide '%s-%s)\n" feature checksum))))
+ (format "(when (not (featurep '%s-%s))
+ (if (file-readable-p \"%s\")
+ (load-file \"%s\")
+ (byte-compile-file \"%s\" t)))"
+ feature checksum bytecode bytecode elisp)))
+
+(defn jack-in
+ "Jack in to a Clojure SLIME session from Emacs.
+
+This task is intended to be launched from Emacs using M-x clojure-jack-in,
+which is part of the clojure-mode library."
+ [project port]
+ (println ";;; Bootstrapping bundled version of SLIME; please wait...\n\n")
+ (let [loaders (string/join "\n" (map loader (elisp-payload-files)))
+ colors? (.contains loaders "slime-frame-colors")]
+ (println loaders)
+ (println "(sleep-for 0.1)") ; TODO: remove
+ (println "(run-hooks 'slime-load-hook) ; on port" port)
+ (println ";;; Done bootstrapping.")
+ (swank/swank project port "localhost" ":colors?" (str colors?)
+ ":message" "\";;; proceed to jack in\"")))
View
74 lein-swank/src/leiningen/swank.clj
@@ -0,0 +1,74 @@
+(ns leiningen.swank
+ "Launch swank server for Emacs to connect."
+ (:require [clojure.java.io :as io]))
+
+(defn opts-list [project-opts port host cli-opts]
+ (apply concat (merge {:repl-out-root true :block true
+ :host "localhost" :port 4005}
+ project-opts
+ (apply hash-map (map read-string cli-opts))
+ (if host {:host host})
+ (if port {:port (Integer. port)}))))
+
+(defn swank-form [project port host cli-opts]
+ ;; bootclasspath workaround: http://dev.clojure.org/jira/browse/CLJ-673
+ (when (:eval-in-leiningen project)
+ (require '[clojure walk template stacktrace]))
+ `(do
+ (when-let [repl-init# '~(:repl-init project)]
+ (require repl-init#))
+ (swank.swank/start-server ~@(opts-list (:swank-options project)
+ port host cli-opts))))
+
+(def ^{:private true} jvm-opts
+ "-agentlib:jdwp=transport=dt_socket,server=y,suspend=n")
+
+(defn- add-cdt-jvm-opts [project]
+ (if (seq (filter #(re-find #"jdwp" %)
+ (:jvm-opts project)))
+ project
+ (update-in project [:jvm-opts] conj jvm-opts)))
+
+(defn add-cdt-project-args
+ "CDT requires the JDK's tools.jar and sa-jdi.jar. Add them to the classpath."
+ [project]
+ (if (:swank-cdt project true)
+ (let [libdir (io/file (System/getProperty "java.home") ".." "lib")
+ extra-cp (for [j ["tools.jar" "sa-jdi.jar"]
+ :when (.exists (io/file libdir j))]
+ (.getAbsolutePath (io/file libdir j)))]
+ (-> project
+ (update-in [:extra-classpath-dirs] concat extra-cp)
+ add-cdt-jvm-opts))
+ project))
+
+(defn eval-in-project
+ "Support eval-in-project in both Leiningen 1.x and 2.x."
+ [project form init]
+ (let [[eip two?] (or (try (require 'leiningen.core.eval)
+ [(resolve 'leiningen.core.eval/eval-in-project)
+ true]
+ (catch java.io.FileNotFoundException _))
+ (try (require 'leiningen.compile)
+ [(resolve 'leiningen.compile/eval-in-project)]
+ (catch java.io.FileNotFoundException _)))]
+ (if two?
+ (eip project form init)
+ (eip project form nil nil init))))
+
+(defn add-swank-dep [project]
+ (if (some #(= 'swank-clojure (first %)) (:dependencies project))
+ project
+ (update-in project [:dependencies] conj ['swank-clojure "1.4.2"])))
+
+(defn swank
+ "Launch swank server for Emacs to connect. Optionally takes PORT and HOST."
+ ([project port host & opts]
+ ;; TODO: only add the dependency if it's not already present
+ (eval-in-project (-> project
+ (add-cdt-project-args)
+ (add-swank-dep))
+ (swank-form project port host opts)
+ '(require 'swank.swank)))
+ ([project port] (swank project port nil))
+ ([project] (swank project nil)))
View
16 lein-swank/src/leiningen/swank_wrap.clj
@@ -0,0 +1,16 @@
+(ns leiningen.swank-wrap
+ (:require [leiningen.swank :as swank]
+ [leiningen.run]))
+
+(defn swank-wrap
+ "Launch a swank server on the specified port, then run a -main function.
+
+ALPHA: subject to change."
+ [project port main & args]
+ (swank/eval-in-project (-> project
+ (swank/add-cdt-project-args)
+ (swank/add-swank-dep))
+ `(do ~(swank/swank-form project port "localhost"
+ [":block" "false"])
+ ~((resolve 'leiningen.run/run-form) main args))
+ `(require '~(symbol main) '~'swank.swank)))
View
37 lein-swank/src/swank/payload/slime-compile-presave.el
@@ -0,0 +1,37 @@
+;;; slime-compile-presave.el --- Refuse to save non-compiling Slime buffers
+
+;; Copyright © 2011 Phil Hagelberg
+;;
+;; Authors: Phil Hagelberg <technomancy@gmail.com>
+;; URL: http://github.com/technomancy/swank-clojure
+;; Version: 1.0.0
+;; Keywords: languages, lisp
+
+;; This file is not part of GNU Emacs.
+
+;;; Code:
+
+(defvar slime-compile-presave? nil
+ "Refuse to save slime-enabled buffers if they don't compile.")
+
+;;;###autoload
+(defun slime-compile-presave-toggle ()
+ (interactive)
+ (message "slime-compile-presave %s."
+ (if (setq slime-compile-presave? (not slime-compile-presave?))
+ "enabled" "disabled")))
+
+;;;###autoload
+(defun slime-compile-presave-enable ()
+ (make-local-variable 'before-save-hook)
+ (add-hook 'before-save-hook (defun slime-compile-presave ()
+ (when slime-compile-presave?
+ (slime-eval `(swank:eval-and-grab-output
+ ,(buffer-substring-no-properties
+ (point-min) (point-max))))))))
+
+;;;###autoload
+(add-hook 'slime-mode-hook 'slime-compile-presave-enable)
+
+(provide 'slime-compile-presave)
+;;; slime-compile-presave.el ends here
View
12 lein-swank/src/swank/payload/slime-eldoc.el
@@ -0,0 +1,12 @@
+(require 'eldoc)
+(defun clojure-slime-eldoc-message ()
+ (when (and (featurep 'slime)
+ (slime-background-activities-enabled-p))
+ (slime-echo-arglist) ; async, return nil for now
+ nil))
+
+(defun clojure-localize-documentation-function ()
+ (set (make-local-variable 'eldoc-documentation-function)
+ 'clojure-slime-eldoc-message))
+
+(add-hook 'slime-mode-hook 'clojure-localize-documentation-function)
View
18 lein-swank/src/swank/payload/slime-frame-colors.el
@@ -0,0 +1,18 @@
+(require 'ansi-color)
+
+(defadvice sldb-insert-frame (around colorize-clj-trace (frame &optional face))
+ (progn
+ (ad-set-arg 0 (list (sldb-frame.number frame)
+ (ansi-color-apply (sldb-frame.string frame))
+ (sldb-frame.plist frame)))
+ ad-do-it
+ (save-excursion
+ (forward-line -1)
+ (skip-chars-forward "0-9 :")
+ (let ((beg-line (point)))
+ (end-of-line)
+ (remove-text-properties beg-line (point) '(face nil))))))
+
+(ad-activate #'sldb-insert-frame)
+
+(provide 'slime-frame-colors)
View
1,854 lein-swank/src/swank/payload/slime-repl.el
@@ -0,0 +1,1854 @@
+;;; slime-repl.el --- Read-Eval-Print Loop written in Emacs Lisp
+;;
+;; Original Author: Helmut Eller
+;; Contributors: to many to mention
+;; License: GNU GPL (same license as Emacs)
+;; URL: http://common-lisp.net/project/slime/
+;; Version: 20091016
+;; Keywords: languages, lisp, slime
+;; Package-Requires: ((slime "20091016"))
+;; Adapted-by: Phil Hagelberg
+;;
+;;; Description:
+;;
+;; This file implements a Lisp Listener along with some niceties like
+;; a persistent history and various "shortcut" commands. Nothing here
+;; depends on comint.el; I/O is multiplexed over SLIME's socket.
+;;
+;; This used to be the default REPL for SLIME, but it was hard to
+;; maintain.
+;;
+;;; Installation:
+;;
+;; Call slime-setup and include 'slime-repl as argument:
+;;
+;; (slime-setup '(slime-repl [others conribs ...]))
+;;
+
+;;;;; 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)
+
+(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)
+
+(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)
+
+
+;; 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))
+
+
+;;;; 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)
+ (setq slime-buffer-package (slime-lisp-package 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))
+
+(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)))
+
+(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 () ,@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))))
+
+(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))
+ (switch-to-buffer (slime-output-buffer))
+ (delete-other-windows)
+ (sit-for 0)
+ (slime-repl-send-string "(swank:io-speed-test 4000 1)")
+ (let ((proc (slime-inferior-process)))
+ (when proc
+ (display-buffer (process-buffer proc) t)
+ (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))))
+
+(defvar slime-repl-popup-on-output nil
+ "Display the output buffer when some output is written.
+This is set to nil after displaying the buffer.")
+
+(defmacro slime-save-marker (marker &rest body)
+ (let ((pos (gensym "pos")))
+ `(let ((,pos (marker-position ,marker)))
+ (prog1 (progn . ,body)
+ (set-marker ,marker ,pos)))))
+
+(put 'slime-save-marker 'lisp-indent-function 1)
+
+(defun slime-repl-emit (string)
+ ;; insert the string STRING in the output buffer
+ (with-current-buffer (slime-output-buffer)
+ (save-excursion
+ (goto-char slime-output-end)
+ (slime-save-marker slime-output-start
+ (slime-propertize-region '(face slime-repl-output-face
+ rear-nonsticky (face))
+ (insert-before-markers string)
+ (when (and (= (point) slime-repl-prompt-start-mark)
+ (not (bolp)))
+ (insert-before-markers "\n")
+ (set-marker slime-output-end (1- (point)))))))
+ (when slime-repl-popup-on-output
+ (setq slime-repl-popup-on-output nil)
+ (display-buffer (current-buffer)))
+ (slime-repl-show-maximum-output)))
+
+(defun slime-repl-emit-result (string &optional bol)
+ ;; insert STRING and mark it as evaluation result
+ (with-current-buffer (slime-output-buffer)
+ (save-excursion
+ (slime-save-marker slime-output-start
+ (slime-save-marker slime-output-end
+ (goto-char slime-repl-input-start-mark)
+ (when (and bol (not (bolp))) (insert-before-markers "\n"))
+ (slime-propertize-region `(face slime-repl-result-face
+ rear-nonsticky (face))
+ (insert-before-markers string)))))
+ (slime-repl-show-maximum-output)))
+
+(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 ()
+ "Select the output buffer, when possible in an existing window.
+
+Hint: You can use `display-buffer-reuse-frames' and
+`special-display-buffer-names' to customize the frame in which
+the buffer should appear."
+ (interactive)
+ (slime-pop-to-buffer (slime-output-buffer))
+ (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 point-max
+;;
+;; input-start is a right inserting marker, because
+;; we want it to stay behind when the user inserts text.
+;;
+;; We maintain the following invariant:
+;;
+;; output-start <= output-end <= input-start.
+;;
+;; 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 insert at that point, we must move the right markers. We should
+;; also not leave (window-)point in the middle of the new output. The
+;; idiom we use is a combination to slime-save-marker,
+;; insert-before-markers, and manually updating window-point
+;; afterwards.
+;;
+;; A "synchronous" evaluation request proceeds as follows: the user
+;; inserts some text between input-start and point-max and then hits
+;; return. We send that region 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. See `slime-repl-insert-prompt'.
+;;
+;; 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).
+;;
+;; 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.
+;;
+
+;; FIXME: slime-lisp-package should be local in a REPL buffer
+(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-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-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))
+ (set markname (make-marker))
+ (set-marker (symbol-value markname) (point))))
+
+;;;;; REPL mode setup
+
+(defvar slime-repl-mode-map)
+
+(let ((map (copy-keymap slime-parent-map)))
+ (set-keymap-parent map lisp-mode-map)
+ (setq slime-repl-mode-map (make-sparse-keymap))
+ (set-keymap-parent slime-repl-mode-map map)
+ (loop for (key command) in slime-editing-keys
+ do (define-key slime-repl-mode-map key command)))
+
+(slime-define-keys slime-prefix-map
+ ("\C-z" 'slime-switch-to-output-buffer)
+ ("\M-p" 'slime-repl-set-package))
+
+(slime-define-keys slime-mode-map
+ ("\C-c~" 'slime-sync-package-and-default-directory)
+ ("\C-c\C-y" 'slime-call-defun))
+
+(slime-define-keys slime-connection-list-mode-map
+ ((kbd "RET") 'slime-goto-connection)
+ ([return] 'slime-goto-connection))
+
+(slime-define-keys slime-repl-mode-map
+ ("\C-m" 'slime-repl-return)
+ ([return] '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)
+ ("\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)
+ ;("\t" 'slime-complete-symbol)
+ ("\t" 'slime-indent-and-complete-symbol)
+ ("\M-\t" 'slime-complete-symbol)
+ (" " 'slime-space)
+ ("\C-c\C-o" 'slime-repl-clear-output)
+ ("\C-c\M-o" '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-z" 'slime-nop))
+
+(slime-define-keys slime-inspector-mode-map
+ ((kbd "M-RET") 'slime-inspector-copy-down-to-repl))
+
+(def-slime-selector-method ?r
+ "SLIME Read-Eval-Print-Loop."
+ (slime-output-buffer))
+
+(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)
+ (when slime-repl-history-file
+ (slime-repl-safe-load-history)
+ (slime-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)
+ (slime-run-mode-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)
+ (save-excursion
+ (when result
+ (destructure-case result
+ ((:values &rest strings)
+ (cond ((null strings)
+ (slime-repl-emit-result "; No value\n" t))
+ (t
+ (dolist (s strings)
+ (slime-repl-emit-result s t)))))))
+ (slime-repl-insert-prompt))
+ (slime-repl-show-maximum-output)))
+
+(defun slime-repl-show-abort ()
+ (with-current-buffer (slime-output-buffer)
+ (save-excursion
+ (slime-save-marker slime-output-start
+ (slime-save-marker slime-output-end
+ (goto-char slime-output-end)
+ (insert-before-markers "; Evaluation aborted.\n")
+ (slime-repl-insert-prompt))))
+ (slime-repl-show-maximum-output)))
+
+(defun slime-repl-insert-prompt ()
+ "Insert the prompt (before markers!).
+Set point after the prompt.
+Return the position of the prompt beginning."
+ (goto-char slime-repl-input-start-mark)
+ (slime-save-marker slime-output-start
+ (slime-save-marker slime-output-end
+ (unless (bolp) (insert-before-markers "\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))
+ (set-marker slime-repl-prompt-start-mark prompt-start)
+ prompt-start))))
+
+(defun slime-repl-show-maximum-output ()
+ "Put the end of the buffer at the bottom of the window."
+ (when (eobp)
+ (let ((win (get-buffer-window (current-buffer))))
+ (when win
+ (with-selected-window win
+ (set-window-point win (point-max))
+ (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 until-point-p
+ (point)
+ (point-max)))))
+
+(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-input-start-mark (point) (current-buffer)))
+
+(defun slime-mark-output-start ()
+ (set-marker slime-output-start (point))
+ (set-marker slime-output-end (point)))
+
+(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-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 ()
+ (<= slime-repl-input-start-mark (point)))
+
+(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)
+
+;; FIXME: this looks very strange
+(defun slime-repl-end-of-defun ()
+ "Move to next of defun."
+ (interactive)
+ ;; C.f. SLIME-REPL-BEGINNING-OF-DEFUN.
+ (if (and (not (= (point) (point-max)))
+ (slime-repl-in-input-area-p))
+ (goto-char (point-max))
+ (end-of-defun))
+ t)
+
+(defun slime-repl-previous-prompt ()
+ "Move backward to the previous prompt."
+ (interactive)
+ (slime-repl-find-prompt t))
+
+(defun slime-repl-next-prompt ()
+ "Move forward to the next prompt."
+ (interactive)
+ (slime-repl-find-prompt))
+
+(defun slime-repl-find-prompt (&optional backward)
+ (let ((origin (point))
+ (prop 'slime-repl-prompt))
+ (while (progn
+ (slime-search-property-change prop backward)
+ (not (or (slime-end-of-proprange-p prop) (bobp) (eobp)))))
+ (unless (slime-end-of-proprange-p prop)
+ (goto-char origin))))
+
+(defun slime-search-property-change (prop &optional backward)
+ (cond (backward
+ (goto-char (previous-single-char-property-change (point) prop)))
+ (t
+ (goto-char (next-single-char-property-change (point) prop)))))
+
+(defun slime-end-of-proprange-p (property)
+ (and (get-char-property (max 1 (1- (point))) property)
+ (not (get-char-property (point) property))))
+
+(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)
+ (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 (point-max))
+ (slime-repl-send-input t))
+ (t
+ (slime-repl-newline-and-indent)
+ (message "[input not complete]"))))
+
+(defun slime-repl-recenter-if-needed ()
+ "Make sure that (point) is visible."
+ (unless (pos-visible-in-window-p (point-max))
+ (save-excursion
+ (goto-char (point-max))
+ (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."
+ (unless (slime-repl-in-input-area-p)
+ (error "No input at point."))
+ (goto-char (point-max))
+ (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-modification-hooks 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 (point-max))
+ (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 (point-max))
+ (unless (eq (char-before) ?\ )
+ (insert " "))))
+ (delete-region (point) (point-max))
+ (save-excursion
+ (insert old-input)
+ (when (equal (char-before) ?\n)
+ (delete-char -1)))
+ (forward-char offset))))
+
+(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 all text from the prompt."
+ (interactive)
+ (delete-region slime-repl-input-start-mark (point-max)))
+
+(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)
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) slime-repl-prompt-start-mark)
+ (delete-region slime-output-start slime-output-end)
+ (when (< (point) slime-repl-input-start-mark)
+ (goto-char slime-repl-input-start-mark))
+ (recenter t))
+ (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-repl-set-package (package)
+ "Set the package of the REPL buffer to PACKAGE."
+ (interactive (list (let* ((p (slime-current-package))
+ (p (and p (slime-pretty-package-name p)))
+ (p (and (not (equal p (slime-lisp-package))) p)))
+ (slime-read-package-name "Package: " p))))
+ (with-current-buffer (slime-output-buffer)
+ (let ((previouse-point (- (point) slime-repl-input-start-mark)))
+ (destructuring-bind (name prompt-string)
+ (slime-repl-shortcut-eval `(swank:set-package ,package))
+ (setf (slime-lisp-package) name)
+ (setf (slime-lisp-package-prompt-string) prompt-string)
+ (setf slime-buffer-package name)
+ (slime-repl-insert-prompt)
+ (when (plusp previouse-point)
+ (goto-char (+ previouse-point slime-repl-input-start-mark)))))))
+
+
+;;;;; 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)
+ "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."
+ (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"))))
+ ;;(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)))
+
+(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)))
+
+(defun slime-repl-forward-input ()
+ "Cycle forwards through input history."
+ (interactive)
+ (slime-repl-history-replace 'forward (slime-repl-history-pattern)))
+
+(defun slime-repl-backward-input ()
+ "Cycle backwards through input history."
+ (interactive)
+ (slime-repl-history-replace 'backward (slime-repl-history-pattern)))
+
+(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
+ (assert (<= slime-repl-input-start-mark (point)))
+ (let ((str (slime-repl-current-input t)))
+ (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)
+ ([return] . 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-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.")
+
+(defvar slime-within-repl-shortcut-handler-p nil
+ "Bound to T if we're in a REPL shortcut handler invoked from the REPL.")
+
+(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))))
+ (with-struct (slime-repl-shortcut. handler) shortcut
+ (let ((slime-within-repl-shortcut-handler-p t))
+ (call-interactively handler))))))
+
+(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 plist specifying the handler doing the actual work
+of the shortcut \(`:handler'\), and a help text \(`:one-liner'\)."
+ `(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 ,@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-repl-shortcut-eval (sexp &optional package)
+ "This function should be used by REPL shortcut handlers instead
+of `slime-eval' to evaluate their final expansion. (This
+expansion will be added to the REPL's history.)"
+ (when slime-within-repl-shortcut-handler-p ; were we invoked via ,foo?
+ (slime-repl-add-to-input-history (prin1-to-string sexp)))
+ (slime-eval sexp package))
+
+(defun slime-repl-shortcut-eval-async (sexp &optional cont package)
+ "This function should be used by REPL shortcut handlers instead
+of `slime-eval-async' to evaluate their final expansion. (This
+expansion will be added to the REPL's history.)"
+ (when slime-within-repl-shortcut-handler-p ; were we invoked via ,foo?
+ (slime-repl-add-to-input-history (prin1-to-string sexp)))
+ (slime-eval-async sexp cont package))
+
+
+(defun slime-list-repl-short-cuts ()
+ (interactive)
+ (slime-with-popup-buffer ("*slime-repl-help*")
+ (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 the current connection."))
+
+(defslime-repl-shortcut slime-repl-disconnect-all ("disconnect-all")
+ (:handler 'slime-disconnect-all)
+ (: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 (lambda ()
+ (interactive)
+ ;; `slime-quit-lisp' determines the connection to quit
+ ;; on behalf of the REPL's `slime-buffer-connection'.
+ (let ((repl-buffer (slime-output-buffer)))
+ (slime-quit-lisp)
+ (kill-buffer repl-buffer))))
+ (: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-repl-shortcut-eval-async
+ `(swank:compile-file-if-needed
+ ,(slime-to-lisp-filename filename) t)
+ #'slime-compilation-finished)))
+ (: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-redirect-inferior-output (&optional noerror)
+ "Redirect output of the inferior-process to the REPL buffer."
+ (interactive)
+ (let ((proc (slime-inferior-process)))
+ (cond (proc
+ (let ((filter (slime-rcurry #'slime-inferior-output-filter
+ (slime-current-connection))))
+ (set-process-filter proc filter)))
+ (noerror)
+ (t (error "No inferior lisp process")))))
+
+(defun slime-inferior-output-filter (proc string conn)
+ (cond ((eq (process-status conn) 'closed)
+ (message "Connection closed. Removing inferior output filter.")
+ (message "Lost output: %S" string)
+ (set-process-filter proc nil))
+ (t
+ (slime-output-filter conn string))))
+
+(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-call-defun ()
+ "Insert a call to the toplevel form defined around point into the REPL."
+ (interactive)
+ (flet ((insert-call (symbol)
+ (let* ((qualified-symbol-name (slime-qualify-cl-symbol-name symbol))
+ (symbol-name (slime-cl-symbol-name qualified-symbol-name))
+ (symbol-package (slime-cl-symbol-package qualified-symbol-name))
+ (function-call
+ (format "(%s " (if (equalp (slime-lisp-package) symbol-package)
+ symbol-name
+ qualified-symbol-name))))
+ (slime-switch-to-output-buffer)
+ (goto-char slime-repl-input-start-mark)
+ (insert function-call)
+ (save-excursion (insert ")")))))
+ (let ((toplevel (slime-parse-toplevel-form)))
+ (if (symbolp toplevel)
+ (error "Not in a function definition")
+ (destructure-case toplevel
+ (((:defun :defgeneric :defmacro :define-compiler-macro) symbol)
+ (insert-call symbol))
+ ((:defmethod symbol &rest args)
+ (declare (ignore args))
+ (insert-call symbol))
+ (t
+ (error "Not in a function definition")))))))
+
+(defun slime-inspector-copy-down-to-repl (number)
+ "Evaluate the inspector 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-set-default-directory (directory)
+ "Make DIRECTORY become Lisp's current directory."
+ (interactive (list (read-directory-name "Directory: " nil nil t)))
+ (let ((dir (expand-file-name directory)))
+ (message "default-directory: %s"
+ (slime-from-lisp-filename
+ (slime-repl-shortcut-eval `(swank:set-default-directory
+ ,(slime-to-lisp-filename dir)))))
+ (with-current-buffer (slime-output-buffer)
+ (setq default-directory dir))))
+
+(defun slime-sync-package-and-default-directory ()
+ "Set Lisp's package and directory to the values in current buffer."
+ (interactive)
+ (let* ((package (slime-current-package))
+ (exists-p (or (null package)
+ (slime-eval `(cl:packagep (swank::guess-package ,package)))))
+ (directory default-directory))
+ (when (and package exists-p)
+ (slime-repl-set-package package))
+ (slime-set-default-directory directory)
+ ;; Sync *inferior-lisp* dir
+ (let* ((proc (slime-process))
+ (buffer (and proc (process-buffer proc))))
+ (when buffer
+ (with-current-buffer buffer
+ (setq default-directory directory))))
+ (message "package: %s%s directory: %s"
+ (with-current-buffer (slime-output-buffer)
+ (slime-lisp-package))
+ (if exists-p "" (format " (package %s doesn't exist)" package))
+ directory)))
+
+(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))))
+
+(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 ])))
+
+(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-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 t)))
+ (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))))))
+
+(defun slime-repl-connected-hook-function ()
+ (destructuring-bind (package prompt)
+ (let ((slime-current-thread t))
+ (slime-eval '(swank:create-repl nil)))
+ (setf (slime-lisp-package) package)
+ (setf (slime-lisp-package-prompt-string) prompt))
+ (slime-hide-inferior-lisp-buffer)
+ (slime-init-output-buffer (slime-connection)))
+
+(defun slime-repl-event-hook-function (event)
+ (destructure-case event
+ ((:write-string output &optional target)
+ (slime-write-string output target)
+ t)
+ ((:read-string thread tag)
+ (assert thread)
+ (slime-repl-read-string thread tag)
+ t)
+ ((:read-aborted thread tag)
+ (slime-repl-abort-read thread tag)
+ t)
+ ((:open-dedicated-output-stream port)
+ (slime-open-stream-to-lisp port)
+ t)
+ ((:new-package package prompt-string)
+ (setf (slime-lisp-package) package)
+ (setf (slime-lisp-package-prompt-string) prompt-string)
+ (let ((buffer (slime-connection-output-buffer)))
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (setq slime-buffer-package package))))
+ t)
+ (t nil)))
+
+(defun slime-repl-find-buffer-package ()
+ (or (slime-search-buffer-package)
+ (slime-lisp-package)))
+
+;;;###autoload
+(defun slime-repl-init ()
+ (add-hook 'slime-event-hooks 'slime-repl-event-hook-function)
+ (add-hook 'slime-connected-hook 'slime-repl-connected-hook-function)
+ (setq slime-find-buffer-package-function 'slime-repl-find-buffer-package))
+
+(defun slime-repl-remove-hooks ()
+ (remove-hook 'slime-event-hooks 'slime-repl-event-hook-function)
+ (remove-hook 'slime-connected-hook 'slime-repl-connected-hook-function))
+
+(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)))))
+
+(defmacro with-canonicalized-slime-repl-buffer (&rest body)
+ "Evaluate BODY within a fresh REPL buffer. The REPL prompt is
+canonicalized to \"SWANK\"---we do actually switch to that
+package, though."
+ `(let ((%old-prompt% (slime-lisp-package-prompt-string)))
+ (unwind-protect
+ (progn (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package-prompt-string) "SWANK"))
+ (kill-buffer (slime-output-buffer))
+ (with-current-buffer (slime-output-buffer)
+ ,@body))
+ (setf (slime-lisp-package-prompt-string) %old-prompt%))))
+
+(put 'with-canonicalized-slime-repl-buffer 'lisp-indent-function 0)
+
+(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> *[]")
+ ("(abort)" "SWANK> (abort)
+{}; Evaluation aborted.
+SWANK> *[]")
+ ("(progn (princ 10) (force-output) (abort))"
+ "SWANK> (progn (princ 10) (force-output) (abort))
+{10}; Evaluation aborted.
+SWANK> *[]")
+ ("(progn (princ 10) (abort))"
+ ;; output can be flushed after aborting
+ "SWANK> (progn (princ 10) (abort))
+{10}; Evaluation aborted.
+SWANK> *[]")
+ ("(if (fresh-line) 1 0)"
+ "SWANK> (if (fresh-line) 1 0)
+{
+}1
+SWANK> *[]")
+ ("(values 1 2 3)" "SWANK> (values 1 2 3)
+{}1
+2
+3
+SWANK> *[]")
+ ("(with-standard-io-syntax
+ (write (make-list 15 :initial-element '(1 . 2)) :pretty t) 0)"
+ "SWANK> (with-standard-io-syntax
+ (write (make-list 15 :initial-element '(1 . 2)) :pretty t) 0)
+{((1 . 2) (1 . 2)