Author: hhubner Date: Mon Jan 28 06:47:40 2008 New Revision: 2410 Modified: branches/trunk-reorg/thirdparty/slime/CVS/Entries branches/trunk-reorg/thirdparty/slime/ChangeLog branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries branches/trunk-reorg/thirdparty/slime/doc/slime.texi branches/trunk-reorg/thirdparty/slime/slime.el branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp branches/trunk-reorg/thirdparty/slime/swank-scl.lisp branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp branches/trunk-reorg/thirdparty/slime/swank.lisp Log: update from recent CVS slime Modified: branches/trunk-reorg/thirdparty/slime/CVS/Entries ============================================================================== --- branches/trunk-reorg/thirdparty/slime/CVS/Entries (original) +++ branches/trunk-reorg/thirdparty/slime/CVS/Entries Mon Jan 28 06:47:40 2008 @@ -1,35 +1,35 @@ -/.cvsignore/1.5/Thu Oct 11 14:10:25 2007// -/HACKING/1.8/Thu Oct 11 14:10:25 2007// -/PROBLEMS/1.8/Thu Oct 11 14:10:25 2007// -/README/1.14/Thu Oct 11 14:10:25 2007// -/hyperspec.el/1.11/Thu Oct 11 14:10:25 2007// -/metering.lisp/1.4/Thu Oct 11 14:10:25 2007// -/mkdist.sh/1.7/Thu Oct 11 14:10:25 2007// -/nregex.lisp/1.4/Thu Oct 11 14:10:25 2007// -/sbcl-pprint-patch.lisp/1.1/Thu Oct 11 14:10:25 2007// -/slime-autoloads.el/1.3/Thu Oct 11 14:10:25 2007// -/swank-abcl.lisp/1.44/Wed Nov 14 21:30:35 2007// -/swank-allegro.lisp/1.98/Thu Oct 11 14:10:25 2007// -/swank-backend.lisp/1.126/Thu Oct 11 14:10:25 2007// -/swank-clisp.lisp/1.64/Thu Oct 11 14:10:25 2007// -/swank-corman.lisp/1.11/Thu Oct 11 14:10:25 2007// -/swank-ecl.lisp/1.8/Thu Oct 11 14:10:25 2007// -/swank-gray.lisp/1.10/Thu Oct 11 14:10:25 2007// -/swank-openmcl.lisp/1.120/Wed Nov 14 21:30:35 2007// -/swank-sbcl.lisp/1.185/Thu Oct 11 14:10:25 2007// -/swank-scl.lisp/1.13/Thu Oct 11 14:10:25 2007// -/swank-source-file-cache.lisp/1.8/Thu Oct 11 14:10:25 2007// -/swank-source-path-parser.lisp/1.17/Thu Oct 11 14:10:25 2007// -/swank.asd/1.5/Thu Oct 11 14:10:25 2007// -/test-all.sh/1.2/Thu Oct 11 14:10:25 2007// -/test.sh/1.9/Thu Oct 11 14:10:25 2007// -/xref.lisp/1.2/Thu Oct 11 14:10:25 2007// D/contrib//// D/doc//// -/ChangeLog/1.1254/Sun Dec 2 04:22:09 2007// -/NEWS/1.9/Sun Dec 2 04:22:09 2007// -/slime.el/1.882/Sun Dec 2 04:22:09 2007// -/swank-cmucl.lisp/1.175/Sun Dec 2 04:22:09 2007// -/swank-lispworks.lisp/1.93/Sun Dec 2 04:22:09 2007// -/swank-loader.lisp/1.75/Sun Dec 2 04:22:09 2007// -/swank.lisp/1.521/Sun Dec 2 04:22:09 2007// +/.cvsignore/1.5/Sun Apr 8 19:23:57 2007// +/ChangeLog/1.1274/Sun Jan 27 22:03:20 2008// +/HACKING/1.8/Sun Jan 27 22:03:20 2008// +/NEWS/1.9/Sun Jan 27 22:03:20 2008// +/PROBLEMS/1.8/Sun Jan 27 22:03:20 2008// +/README/1.14/Sun Jan 27 22:03:20 2008// +/hyperspec.el/1.11/Sun Jan 27 22:03:20 2008// +/metering.lisp/1.4/Sun Jan 27 22:03:20 2008// +/mkdist.sh/1.7/Sun Jan 27 22:03:20 2008// +/nregex.lisp/1.4/Sun Jan 27 22:03:20 2008// +/sbcl-pprint-patch.lisp/1.1/Sun Jan 27 22:03:20 2008// +/slime-autoloads.el/1.3/Sun Jan 27 22:03:20 2008// +/slime.el/1.896/Sun Jan 27 22:03:20 2008// +/swank-abcl.lisp/1.44/Sun Jan 27 22:03:20 2008// +/swank-allegro.lisp/1.98/Sun Jan 27 22:03:20 2008// +/swank-backend.lisp/1.126/Sun Jan 27 22:03:21 2008// +/swank-clisp.lisp/1.64/Sun Jan 27 22:03:21 2008// +/swank-cmucl.lisp/1.175/Sun Jan 27 22:03:21 2008// +/swank-corman.lisp/1.11/Sun Jan 27 22:03:21 2008// +/swank-ecl.lisp/1.11/Sun Jan 27 22:03:21 2008// +/swank-gray.lisp/1.10/Sun Jan 27 22:03:21 2008// +/swank-lispworks.lisp/1.93/Sun Jan 27 22:03:21 2008// +/swank-loader.lisp/1.75/Sun Jan 27 22:03:21 2008// +/swank-openmcl.lisp/1.120/Sun Jan 27 22:03:21 2008// +/swank-sbcl.lisp/1.187/Sun Jan 27 22:03:21 2008// +/swank-scl.lisp/1.14/Sun Jan 27 22:03:21 2008// +/swank-source-file-cache.lisp/1.8/Sun Jan 27 22:03:21 2008// +/swank-source-path-parser.lisp/1.18/Sun Jan 27 22:03:21 2008// +/swank.asd/1.5/Sun Jan 27 22:03:21 2008// +/swank.lisp/1.523/Sun Jan 27 22:03:21 2008// +/test-all.sh/1.2/Sun Jan 27 22:03:21 2008// +/test.sh/1.9/Sun Jan 27 22:03:21 2008// +/xref.lisp/1.2/Sun Jan 27 22:03:21 2008// Modified: branches/trunk-reorg/thirdparty/slime/ChangeLog ============================================================================== --- branches/trunk-reorg/thirdparty/slime/ChangeLog (original) +++ branches/trunk-reorg/thirdparty/slime/ChangeLog Mon Jan 28 06:47:40 2008 @@ -1,3 +1,156 @@ +2008-01-27 Helmut Eller <heller@common-lisp.net> + + Make it easier to start a non-default Lisp from ELisp code. + + * slime.el (slime): If the argument is a symbol start the + corresponding entry in slime-lisp-implementations. + Typical use is something like: + (defun cmucl () (interactive) (slime 'cmucl)) + +2008-01-22 Lu�s Oliveira <loliveira@common-lisp.net> + + * swank-source-path-parser.lisp (make-source-recording-readtable): + don't suppress the #. reader macro. + (read-and-record-source-map): don't bind *read-eval* to nil. + (suppress-sharp-dot): unused, delete it. + + * slime.el (test compile-defun): test with #+#.'(:and). + +2008-01-21 Helmut Eller <heller@common-lisp.net> + + * slime.el (sldb-mode): Don't throw to toplevel in the + kill-buffer-hook, since the buffer can be killed for other reasons + too. + (test break): Test BREAK and CONTINUE in a loop. + (slime-wait-condition): Display the current time. + +2008-01-20 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> + + New hooks that allow the slime-presentations contrib to hook + into the debugger and inspector. + + * slime.el (sldb-insert-frame-variable-value-function): New + variable. + (sldb-insert-frame-variable-value): New function, default value + for sldb-insert-frame-variable-value-function. + (sldb-insert-locals): Use it here. + + * slime.el (slime-inspector-insert-ispec-function): New variable. + (slime-open-inspector): Use it here. + +2008-01-20 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> + + * doc/slime.texi (Presentations): Improve documentation of + presentations. + +2008-01-19 Geo Carncross <geocar@gmail.com> + + * swank-ecl.lisp (inspect-for-emacs): Make ECL inspection better; + should be able to handle all builtin types and CLOS objects now. + +2008-01-17 Nikodemus Siivola <nikodemus@random-state.net> + + * swank-sbcl.lisp (sbcl-source-file-p): When a buffer is not + associated with any file, M-. for names defined there ends up + calling SBCL-SOURCE-FILE-P with NIL -- guard against that. + +2008-01-14 Tobias C. Rittweiler <tcr@freebits.de> + + * slime.el (sldb-mode): Add `sldb-quit' to `kill-buffer-hook' to + close the debugging machinery on swank side when the SLDB buffer + is killed. (Notice that killing the SLDB buffer manually will not + restore window configuration in contrast to typing `q'.) + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * slime.el (slime-delete-and-extract-region): New + function. Portable version of `delete-and-extract-region' which + returned NIL instead of "", as experienced by Matthias Koeppe. + +2008-01-09 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> + + * slime.el (slime-repl-mode-map): Bind C-c C-t to + slime-toggle-trace-fdefinition (as in Lisp buffers) instead of + slime-repl-clear-buffer. This binding is useful for untracing + functions directly from the trace output. Move + slime-repl-clear-buffer to the keybinding C-c M-o. + +2008-01-04 Juho Snellman <jsnell@iki.fi> + + * swank-sbcl.lisp (source-file-source-location): Use the + debootstrap readtable when appropriate (fixes occasional reader + errors when using "v" on debugger frames that point to functions + defined in SBCL). Likewise for the debootstrapping packages. + (code-location-debug-source-name): Ensure that we always return a + physical namestring, Emacs won't like a pathname or a logical + namestring. + +2008-01-02 Lu�s Oliveira <loliveira@common-lisp.net> + + Use sane default values for slime-repl-set-package. + + Previously, when typing `,!p' at the REPL, the current package + would have been inserted as a default (although the whole intent + was to /change/ the current package in the first place), now + nothing is inserted anymore. + + * slime.el (slime-pretty-current-package): rename it to + slime-pretty-find-buffer-package and make it use + slime-find-buffer-package instead of slime-current-package. + (slime-repl-set-package, slime-set-package): use new function. + +2008-01-02 Tobias C. Rittweiler <tcr@freebits.de> + + * slime.el (slime-print-apropos): Simplified: Don't insert action + properties anymore for the symbol; they were ignored anyway, + because `apropos-follow' (bound to RET in the resulting + *SLIME Apropos* buffer) looks for buttons only. + +2008-01-02 Tobias C. Rittweiler <tcr@freebits.de> + + * slime.el (slime-apropos): Update docstring: Apropos doesn't + match on regular expressions anymore since 2007-11-24. + +2007-12-22 Douglas Crosher <dcrosher@common-lisp.net> + + * swank-scl.lisp (set-stream-timeout, make-socket-io-stream): update + for Scieneer CL 1.3.7. + +2007-12-20 Tobias C. Rittweiler <tcr@freebits.de> + + * swank.lisp (read-softly-from-string): Now actually returns all + three values as explained in its docstring. + +2007-12-14 Tobias C. Rittweiler <tcr@freebits.de> + + * slime.el (slime-insert-xref-location): New function. Tries to + either insert the file name a function is defined in, or inserts + information about the buffer a function was interactively + `C-c C-c'd from. Idea from Knut Olav B�hmer. + (slime-insert-xrefs): Use it. + +2007-12-04 Helmut Eller <heller@common-lisp.net> + + Simplify the inspector. + + * swank.lisp (inspect-object): Ignore the title value returned + from backends. + + * slime.el (slime-open-inspector): Updated accordingly. + +2007-12-04 Helmut Eller <heller@common-lisp.net> + + Fix slime-list-thread selector. + + * slime.el (slime-list-threads): Wait for the result before + continuing. + +2007-12-04 Helmut Eller <heller@common-lisp.net> + + * slime.el (slime-repl-insert-result): Use slime-repl-emit-result + since handling of markers has changed. + (slime-repl-emit-result): New argument: bol. + 2007-12-02 Alan Caulkins <fatman@maxint.net> Make it possible to close listening sockets. @@ -7,7 +160,7 @@ (setup-server): Store open sockets in *listener-sockets*. 2007-12-02 Helmut Eller <heller@common-lisp.net> - + Add hook to customize the region used by C-c C-c. Useful to recognize block declarations in CMUCL sources. Modified: branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/CVS/Entries Mon Jan 28 06:47:40 2008 @@ -1,30 +1,33 @@ -/README/1.3/Thu Oct 11 14:10:25 2007// -/bridge.el/1.1/Thu Oct 11 14:10:25 2007// -/inferior-slime.el/1.2/Thu Oct 11 14:10:25 2007// -/slime-asdf.el/1.3/Thu Oct 11 14:10:25 2007// -/slime-autodoc.el/1.5/Thu Oct 11 14:10:25 2007// -/slime-banner.el/1.4/Thu Oct 11 14:10:25 2007// -/slime-c-p-c.el/1.8/Thu Oct 11 14:10:25 2007// -/slime-editing-commands.el/1.5/Thu Oct 11 14:10:25 2007// -/slime-fancy-inspector.el/1.2/Thu Oct 11 14:10:25 2007// -/slime-fancy.el/1.4/Thu Oct 11 14:10:25 2007// -/slime-highlight-edits.el/1.3/Thu Oct 11 14:10:25 2007// -/slime-parse.el/1.7/Thu Oct 11 14:10:25 2007// -/slime-presentation-streams.el/1.2/Thu Oct 11 14:10:25 2007// -/slime-presentations.el/1.8/Thu Oct 11 14:10:25 2007// -/slime-references.el/1.4/Thu Oct 11 14:10:25 2007// -/slime-scratch.el/1.4/Thu Oct 11 14:10:25 2007// -/slime-tramp.el/1.2/Thu Oct 11 14:10:25 2007// -/slime-typeout-frame.el/1.5/Thu Oct 11 14:10:25 2007// -/slime-xref-browser.el/1.1/Thu Oct 11 14:10:25 2007// -/swank-asdf.lisp/1.1/Thu Oct 11 14:10:25 2007// -/swank-c-p-c.lisp/1.2/Thu Oct 11 14:10:25 2007// -/swank-fuzzy.lisp/1.6/Thu Oct 11 14:10:25 2007// -/swank-listener-hooks.lisp/1.1/Thu Oct 11 14:10:25 2007// -/swank-presentation-streams.lisp/1.4/Thu Oct 11 14:10:25 2007// -/swank-presentations.lisp/1.4/Thu Oct 11 14:10:25 2007// -/swank-fancy-inspector.lisp/1.5/Wed Nov 21 20:47:43 2007// -/ChangeLog/1.68/Sun Dec 2 04:22:09 2007// -/slime-fuzzy.el/1.5/Sun Dec 2 04:22:09 2007// -/swank-arglists.lisp/1.15/Sun Dec 2 04:22:10 2007// +/ChangeLog/1.82/Sun Jan 27 22:03:21 2008// +/README/1.3/Sun Jan 27 22:03:21 2008// +/bridge.el/1.1/Sun Jan 27 22:03:22 2008// +/inferior-slime.el/1.2/Sun Jan 27 22:03:22 2008// +/slime-asdf.el/1.3/Sun Jan 27 22:03:22 2008// +/slime-autodoc.el/1.7/Sun Jan 27 22:03:22 2008// +/slime-banner.el/1.4/Sun Jan 27 22:03:22 2008// +/slime-c-p-c.el/1.8/Sun Jan 27 22:03:22 2008// +/slime-editing-commands.el/1.6/Sun Jan 27 22:03:22 2008// +/slime-fancy-inspector.el/1.2/Sun Jan 27 22:03:22 2008// +/slime-fancy.el/1.4/Sun Jan 27 22:03:22 2008// +/slime-fuzzy.el/1.6/Sun Jan 27 22:03:22 2008// +/slime-highlight-edits.el/1.3/Sun Jan 27 22:03:22 2008// +/slime-parse.el/1.10/Sun Jan 27 22:03:22 2008// +/slime-presentation-streams.el/1.2/Sun Jan 27 22:03:22 2008// +/slime-presentations.el/1.12/Sun Jan 27 22:03:22 2008// +/slime-references.el/1.4/Sun Jan 27 22:03:22 2008// +/slime-scheme.el/1.1/Wed Jan 9 18:30:26 2008// +/slime-scratch.el/1.4/Sun Jan 27 22:03:22 2008// +/slime-tramp.el/1.2/Sun Jan 27 22:03:22 2008// +/slime-typeout-frame.el/1.6/Sun Jan 27 22:03:22 2008// +/slime-xref-browser.el/1.1/Sun Jan 27 22:03:22 2008// +/swank-arglists.lisp/1.18/Sun Jan 27 22:03:22 2008// +/swank-asdf.lisp/1.1/Sun Jan 27 22:03:22 2008// +/swank-c-p-c.lisp/1.2/Sun Jan 27 22:03:22 2008// +/swank-fancy-inspector.lisp/1.5/Sun Jan 27 22:03:22 2008// +/swank-fuzzy.lisp/1.7/Sun Jan 27 22:03:22 2008// +/swank-goo.goo/1.1/Sat Jan 19 14:08:27 2008// +/swank-kawa.scm/1.1/Sat Jan 19 14:08:27 2008// +/swank-listener-hooks.lisp/1.1/Sun Jan 27 22:03:22 2008// +/swank-presentation-streams.lisp/1.4/Sun Jan 27 22:03:22 2008// +/swank-presentations.lisp/1.4/Sun Jan 27 22:03:22 2008// D Modified: branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog Mon Jan 28 06:47:40 2008 @@ -1,3 +1,151 @@ +2008-01-27 Helmut Eller <heller@common-lisp.net> + + Make autodoc use the correct width of the typeout-window. + + * slime-autodoc.el (slime-autodoc-dimensions-function): New + variable. + (slime-autodoc-message-dimensions): Use it. + + * slime-typeout-frame.el (slime-typeout-autodoc-dimensions): New + function. + (slime-typeout-frame-init): Use it. + +2008-01-27 Helmut Eller <heller@common-lisp.net> + + Use slime-require instead of a connected-hook. + + * slime-autodoc.el (slime-autodoc-on-connect): Deleted. + +2008-01-20 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> + + Hook presentations into debugger and inspector, restoring + features that were removed on 2007-08-27. + + * slime-presentations.el (slime-presentation-add-easy-menu): + Install presentation menu also in the debugger and inspector. + (slime-presentation-inspector-insert-ispec): New. + (slime-presentation-sldb-insert-frame-variable-value): New. + (slime-presentations-init): Install these functions as + slime-inspector-insert-ispec-function and + sldb-insert-frame-variable-value-function. + +2008-01-19 Helmut Eller <heller@common-lisp.net> + + * swank-goo.goo: New file. + * swank-kawa.scm: New file. + +2008-01-11 Stelian Ionescu <sionescu@common-lisp.net> + + * slime-presentations.el + (slime-copy-or-inspect-presentation-at-mouse): Call + slime-copy-presentation-at-mouse-to-repl rather than + slime-copy-presentation-at-mouse. + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * slime-parse.el (slime-make-form-spec-from-string): Correctly + handle quoted things and other non-proper "(...)" forms. + + * swank-arglist.lisp (read-form-spec): Added assertion against + receiving junk form specs from Emacs. + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * slime-editing-commands.el (slime-close-all-parens-in-sexp): Use + new portability function `slime-delete-and-extract-region'. + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * swank-parse.lisp (slime-incomplete-form-at-point): Hopefully + better fix than before. + +2008-01-10 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> + + Add keyboard commands (starting with C-c C-v) and a top-level menu + for presentation-related commands. Add a command (C-c C-v M-o) to + forget all objects associated with presentations, without + clearing the REPL buffer. + + * slime-presentations.el + (slime-presentation-around-or-before-point-or-error): New + function. + (slime-inspect-presentation): New function, factored out from + slime-inspect-presentation-at-mouse. + (slime-inspect-presentation-at-mouse): Use it here. + (slime-inspect-presentation-at-point): New command. + (slime-copy-presentation-to-repl): New function, factored out + from slime-copy-presentation-at-mouse. + (slime-copy-presentation-at-mouse-to-repl): Renamed from + slime-copy-presentation-at-mouse; use the new function + slime-copy-presentation-to-repl. + (slime-copy-presentation-at-point-to-repl): New command. + (slime-copy-presentation-to-kill-ring): New function, factored + out from slime-copy-presentation-at-mouse-to-kill-ring. + (slime-copy-presentation-at-point-to-kill-ring): New command. + (slime-describe-presentation): New function, factored out from + slime-describe-presentation-at-mouse. + (slime-describe-presentation-at-mouse): Use it here. + (slime-describe-presentation-at-point): New command. + (slime-pretty-print-presentation): New function, factored out + from slime-pretty-print-presentation-at-mouse. + (slime-pretty-print-presentation-at-mouse): Use it here. + (slime-pretty-print-presentation-at-point): New command. + (slime-mark-presentation): New command. + (slime-previous-presentation, slime-next-presentation): New + commands. + (slime-presentation-command-map, slime-presentation-bindings): + New variables. + (slime-presentation-init-keymaps): New function. + (slime-presentation-around-or-before-point-p): New function. + (slime-presentation-easy-menu): New variable. + (slime-presentation-add-easy-menu): New function. + (slime-clear-presentations): Make interactive, remove + presentation markup from all presentations in the REPL buffer. + (slime-presentations-init): Call slime-presentation-init-keymaps + and slime-presentation-add-easy-menu. + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * swank-parse.lisp (slime-incomplete-form-at-point): Take the + arglist index the user's point is located at correctly into + account. Previously `C-c C-s' on `(defun |foo' would have inserted + `args body...)', now it inserts `name args body...)' + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * swank-arglists.lisp (read-form-spec): Changed "cons" clause to + "list" clause in etypecase. Fix for error on arglist display on + `(declare (ftype (|)))', | being point. + +2008-01-10 Tobias C. Rittweiler <tcr@freebits.de> + + * slime-fuzzy.el (slime-fuzzy-completion-time-limit-in-msec): + Update docstring: Its value isn't rounded to nearest second, but + is really interpreted as msecs. + + * swank-fuzzy.el: Updated some comments. + (fuzzy-generate-matchings): Sort package matchings before + traversal, such that they're traversed in the order of their + score. (Important when time limit exhausts during traversal.) + +2008-01-09 Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> + + Restore support for Scheme programs that was removed from core + SLIME on 2007-09-19, as a "slime-scheme" contrib. + + * slime-scheme.el: New file. + +2007-12-30 Tobias C. Rittweiler <tcr@freebits.de> + + * swank-arglists.lisp: Fix for `(cerror "FOO" 'type-error ...)' + + (*arglist-dummy*): Removed. + (arglist-dummy): New structure. Wrapper around whatever could not + be reliably read. The clue is that its printing function does only + print the object this structure contains. + (read-conversatively-for-autodoc): Return such a structure if + conversative reading fails. + 2007-11-27 Tobias C. Rittweiler <tcr@freebits.de> * swank-arglists.lisp (arglist-dispatch 'defmethod): Use Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-autodoc.el Mon Jan 28 06:47:40 2008 @@ -116,10 +116,14 @@ (setq slime-autodoc-last-message doc) (message "%s" doc)) +(defvar slime-autodoc-dimensions-function nil) + (defun slime-autodoc-message-dimensions () "Return the available width and height for pretty printing autodoc messages." (cond + (slime-autodoc-dimensions-function + (funcall slime-autodoc-dimensions-function)) (slime-autodoc-use-multiline-p ;; Use the full width of the minibuffer; ;; minibuffer will grow vertically if necessary @@ -253,21 +257,18 @@ (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))) +(slime-require :swank-arglists) + (provide 'slime-autodoc) Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-editing-commands.el Mon Jan 28 06:47:40 2008 @@ -69,7 +69,7 @@ (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)) + (ignore-errors (backward-up-list 1) t)) (incf sexp-level)))) (when (> sexp-level 0) ;; insert correct number of right parens @@ -79,7 +79,7 @@ (setq point (point)) (skip-chars-forward " \t\n)") (skip-chars-backward " \t\n") - (let* ((deleted-region (delete-and-extract-region point (point))) + (let* ((deleted-region (slime-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 Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-fuzzy.el Mon Jan 28 06:47:40 2008 @@ -30,8 +30,8 @@ :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)" + "Limit the time spent (given in msec) in swank while gathering +comletitions." :group 'slime-mode :type 'integer) Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-parse.el Mon Jan 28 06:47:40 2008 @@ -16,14 +16,15 @@ (slime-enclosing-form-specs) (if (null operators) "" - (let ((op (first operators))) + (let ((op (first operators)) + (op-start (first points)) + (arg-index (first arg-indices))) (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))))))))))) + (t + (slime-make-form-spec-from-string + (concat (slime-incomplete-sexp-at-point) ")")))))))) ;; XXX: unused function (defun slime-cl-symbol-external-ref-p (symbol) @@ -228,9 +229,11 @@ => (\"foo\" (\"bar\" \"1\" (\"baz\" \":quux\")) \"'toto\") " - (cond ((slime-length= string 0) "") - ((equal string "()") '()) - (t + (cond ((slime-length= string 0) "") ; "" + ((equal string "()") '()) ; "()" + ((eql (char-syntax (aref string 0)) ?\') string) ; "'(foo)", "#(foo)" &c + ((not (eql (aref string 0) ?\()) string) ; "foo" + (t ; "(op arg1 arg2 ...)" (with-temp-buffer ;; Do NEVER ever try to activate `lisp-mode' here with ;; `slime-use-autodoc-mode' enabled, as this function is used @@ -246,17 +249,18 @@ (delete-region (point-min) (point)) (insert "("))) (goto-char (1- (point-max))) ; `(OP arg1 ... argN|)' + (assert (eql (char-after) ?\))) (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)))))))))) + (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) Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-presentations.el Mon Jan 28 06:47:40 2008 @@ -275,6 +275,13 @@ (values presentation start end whole-p) (slime-presentation-around-point (1- point) object))))) +(defun slime-presentation-around-or-before-point-or-error (point) + (multiple-value-bind (presentation start end whole-p) + (slime-presentation-around-or-before-point point) + (unless presentation + (error "No presentation at point")) + (values presentation start end whole-p))) + (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 @@ -345,40 +352,58 @@ (slime-presentation-around-click event) (if (with-current-buffer buffer (eq major-mode 'slime-repl-mode)) - (slime-copy-presentation-at-mouse event) + (slime-copy-presentation-at-mouse-to-repl event) (slime-inspect-presentation-at-mouse event)))) +(defun slime-inspect-presentation (presentation start end buffer) + (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-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)))) + (slime-inspect-presentation presentation start end buffer))) + +(defun slime-inspect-presentation-at-point (point) + (interactive "d") + (multiple-value-bind (presentation start end) + (slime-presentation-around-or-before-point-or-error point) + (slime-inspect-presentation presentation start end (current-buffer)))) + +(defun slime-copy-presentation-to-repl (presentation start end buffer) + (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 (event) +(defun slime-copy-presentation-at-mouse-to-repl (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))))))) + (slime-copy-presentation-to-repl presentation start end buffer))) + +(defun slime-copy-presentation-at-point-to-repl (point) + (interactive "d") + (multiple-value-bind (presentation start end) + (slime-presentation-around-or-before-point-or-error point) + (slime-copy-presentation-to-repl presentation start end (current-buffer)))) (defun slime-copy-presentation-at-mouse-to-point (event) (interactive "e") @@ -395,29 +420,94 @@ (when (and (not (eolp)) (not (looking-at "\\s-"))) (insert " "))))) +(defun slime-copy-presentation-to-kill-ring (presentation start end buffer) + (let ((presentation-text + (with-current-buffer buffer + (buffer-substring start end)))) + (kill-new presentation-text) + (message "Saved presentation \"%s\" to kill ring" presentation-text))) + (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)))) + (slime-copy-presentation-to-kill-ring presentation start end buffer))) + +(defun slime-copy-presentation-at-point-to-kill-ring (point) + (interactive "d") + (multiple-value-bind (presentation start end) + (slime-presentation-around-or-before-point-or-error point) + (slime-copy-presentation-to-kill-ring presentation start end (current-buffer)))) +(defun slime-describe-presentation (presentation) + (slime-eval-describe + `(swank::describe-to-string + (swank::lookup-presented-object ',(slime-presentation-id presentation))))) + (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)))))) + (slime-describe-presentation presentation))) + +(defun slime-describe-presentation-at-point (point) + (interactive "d") + (multiple-value-bind (presentation) + (slime-presentation-around-or-before-point-or-error point) + (slime-describe-presentation presentation))) + +(defun slime-pretty-print-presentation (presentation) + (slime-eval-describe + `(swank::swank-pprint + (cl:list + (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))))))) + (slime-pretty-print-presentation presentation))) + +(defun slime-pretty-print-presentation-at-point (point) + (interactive "d") + (multiple-value-bind (presentation) + (slime-presentation-around-or-before-point-or-error point) + (slime-pretty-print-presentation presentation))) + +(defun slime-mark-presentation (point) + (interactive "d") + (multiple-value-bind (presentation start end) + (slime-presentation-around-or-before-point-or-error point) + (goto-char start) + (push-mark end nil t))) + +(defun slime-previous-presentation () + "Move point to the beginning of the first presentation before point." + (interactive) + ;; First skip outside the current surrounding presentation (if any) + (multiple-value-bind (presentation start end) + (slime-presentation-around-point (point)) + (when presentation + (goto-char start))) + (let ((p (previous-single-property-change (point) 'slime-repl-presentation))) + (unless p + (error "No previous presentation")) + (multiple-value-bind (presentation start end) + (slime-presentation-around-or-before-point-or-error p) + (goto-char start)))) + +(defun slime-next-presentation () + "Move point to the beginning of the next presentation after point." + (interactive) + ;; First skip outside the current surrounding presentation (if any) + (multiple-value-bind (presentation start end) + (slime-presentation-around-point (point)) + (when presentation + (goto-char end))) + (let ((p (next-single-property-change (point) 'slime-repl-presentation))) + (unless p + (error "No next presentation")) + (multiple-value-bind (presentation start end) + (slime-presentation-around-or-before-point-or-error p) + (goto-char start)))) (defvar slime-presentation-map (make-sparse-keymap)) @@ -451,7 +541,7 @@ ("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 REPL" . ,(savel 'slime-copy-presentation-at-mouse-to-repl)) ("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)))) @@ -541,6 +631,64 @@ (let ((inhibit-read-only t)) (insert old-output))))) +;;; Presentation-related key bindings, non-context menu + +(defvar slime-presentation-command-map (make-sparse-keymap) + "Keymap for presentation-related commands. Bound to a prefix key.") + +(defvar slime-presentation-bindings + '((?i slime-inspect-presentation-at-point) + (?d slime-describe-presentation-at-point) + (?w slime-copy-presentation-at-point-to-kill-ring) + (?r slime-copy-presentation-at-point-to-repl) + (?p slime-previous-presentation) + (?n slime-next-presentation) + (? slime-mark-presentation))) + +(defun slime-presentation-init-keymaps () + (setq slime-presentation-command-map (make-sparse-keymap)) + (loop for (key command) in slime-presentation-bindings + do (progn + ;; We bind both unmodified and with control. + (define-key slime-presentation-command-map (vector key) command) + (let ((modified (slime-control-modified-char key))) + (define-key slime-presentation-command-map (vector modified) command)))) + (define-key slime-presentation-command-map "\M-o" 'slime-clear-presentations) + ;; C-c C-v is the prefix for the presentation-command map. + (slime-define-key "\C-v" slime-presentation-command-map :prefixed t :inferior t) + (define-key slime-repl-mode-map "\C-c\C-v" slime-presentation-command-map) + (define-key sldb-mode-map "\C-c\C-v" slime-presentation-command-map) + (define-key slime-inspector-mode-map "\C-c\C-v" slime-presentation-command-map)) + +(defun slime-presentation-around-or-before-point-p () + (multiple-value-bind (presentation beg end) + (slime-presentation-around-or-before-point (point)) + presentation)) + +(defvar slime-presentation-easy-menu + (let ((P '(slime-presentation-around-or-before-point-p))) + `("Presentations" + [ "Inspect" slime-inspect-presentation-at-point ,P ] + [ "Describe" slime-describe-presentation-at-point ,P ] + [ "Pretty-print" slime-pretty-print-presentation-at-point ,P ] + [ "Copy to REPL" slime-copy-presentation-at-point-to-repl ,P ] + [ "Copy to kill ring" slime-copy-presentation-at-point-to-kill-ring ,P ] + [ "Mark" slime-mark-presentation ,P ] + "--" + [ "Previous presentation" slime-previous-presentation ] + [ "Next presentation" slime-next-presentation ] + "--" + [ "Clear all presentations" slime-clear-presentations ]))) + +(defun slime-presentation-add-easy-menu () + (easy-menu-define menubar-slime-presentation slime-mode-map "Presentations" slime-presentation-easy-menu) + (easy-menu-define menubar-slime-presentation slime-repl-mode-map "Presentations" slime-presentation-easy-menu) + (easy-menu-define menubar-slime-presentation sldb-mode-map "Presentations" slime-presentation-easy-menu) + (easy-menu-define menubar-slime-presentation slime-inspector-mode-map "Presentations" slime-presentation-easy-menu) + (easy-menu-add slime-presentation-easy-menu 'slime-mode-map) + (easy-menu-add slime-presentation-easy-menu 'slime-repl-mode-map) + (easy-menu-add slime-presentation-easy-menu 'sldb-mode-map) + (easy-menu-add slime-presentation-easy-menu 'slime-inspector-mode-map)) ;;; hook functions (hard to isolate stuff) @@ -622,7 +770,38 @@ bridge-handlers))) (defun slime-clear-presentations () - (slime-eval-async `(swank:clear-repl-results))) + "Forget all objects associated to SLIME presentations. +This allows the garbage collector to remove these objects +even on Common Lisp implementations without weak hash tables." + (interactive) + (slime-eval-async `(swank:clear-repl-results)) + (unless (eql major-mode 'slime-repl-mode) + (slime-switch-to-output-buffer)) + (slime-for-each-presentation-in-region 1 (1+ (buffer-size)) + (lambda (presentation from to whole-p) + (slime-remove-presentation-properties from to + presentation)))) + +(defun slime-presentation-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) + (slime-insert-presentation string `(:inspected-part ,id) t))) + ((:action string id) + (slime-insert-propertized (list 'slime-action-number id + 'mouse-face 'highlight + 'face 'slime-inspector-action-face) + string))))) + +(defun slime-presentation-sldb-insert-frame-variable-value (value frame index) + (slime-insert-presentation + (in-sldb-face local-value value) + `(:frame-var ,slime-current-thread ,(car frame) ,i) t)) ;;; Initialization @@ -639,7 +818,12 @@ (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)) + (add-hook 'slime-connected-hook 'slime-install-presentations) + (setq slime-inspector-insert-ispec-function 'slime-presentation-inspector-insert-ispec) + (setq sldb-insert-frame-variable-value-function + 'slime-presentation-sldb-insert-frame-variable-value) + (slime-presentation-init-keymaps) + (slime-presentation-add-easy-menu)) (defun slime-install-presentations () (slime-eval-async '(swank:swank-require :swank-presentations))) Modified: branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/slime-typeout-frame.el Mon Jan 28 06:47:40 2008 @@ -64,6 +64,12 @@ (setq slime-autodoc-last-message "") (slime-typeout-message-aux "%s" doc)) +(defun slime-typeout-autodoc-dimensions () + (cond ((slime-typeout-active-p) + (list (window-width slime-typeout-window) nil)) + (t + (list 75 nil)))) +  ;;; Initialization @@ -74,7 +80,8 @@ (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)) + (slime-autodoc-message-function slime-typeout-autodoc-message) + (slime-autodoc-dimensions-function slime-typeout-autodoc-dimensions)) do (slime-typeout-frame-init-var var value))) (defun slime-typeout-frame-init-var (var value) @@ -86,6 +93,7 @@ (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))))) + (t (set var value)))) + (setq slime-typeout-frame-unbind-stack nil)) (provide 'slime-typeout-frame) Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/swank-arglists.lisp Mon Jan 28 06:47:40 2008 @@ -72,7 +72,14 @@ (let ((op-rawspec (nth (1+ position) raw-specs))) (first (parse-form-spec op-rawspec #'read-conversatively-for-autodoc)))) -(defvar *arglist-dummy* (cons :dummy nil)) +;; This is a wrapper object around anything that came from Slime and +;; could not reliably be read. +(defstruct (arglist-dummy + (:conc-name #:arglist-dummy.) + (:print-object (lambda (struct stream) + (with-struct (arglist-dummy. string-representation) struct + (write-string string-representation stream))))) + string-representation) (defun read-conversatively-for-autodoc (string) "Tries to find the symbol that's represented by STRING. @@ -83,8 +90,8 @@ 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 +In such a case (that no symbol could be found), an object of type +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) #\'))) @@ -92,7 +99,7 @@ (parse-symbol (if quoted? (subseq string 1) string)) (if found? (if quoted? `(quote ,symbol) symbol) - *arglist-dummy*)))) + (make-arglist-dummy :string-representation string))))) (defun parse-form-spec (raw-spec &optional reader) @@ -215,7 +222,7 @@ (push sexp result) (when newly-interned? (push sexp newly-interned-symbols)))) - (cons + (list (multiple-value-bind (read-spec interned-symbols) (read-form-spec element reader) (push read-spec result) @@ -232,7 +239,8 @@ the flag if a symbol had to be interned." (multiple-value-bind (sexp pos interned?) (read-softly-from-string string) - (declare (ignore pos)) + ;; To make sure that we haven't got any junk from Emacs. + (assert (= pos (length string))) (values sexp interned?))) Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fuzzy.lisp Mon Jan 28 06:47:40 2008 @@ -220,15 +220,20 @@ ;; relative to all the packages found. (multiple-value-bind (found-packages rest-time-limit) (find-packages parsed-package-name time-limit-in-msec) + ;; We want to traverse the found packages in the order of their score, + ;; since those with higher score presumably represent better choices. + ;; (This is important because some packages may never be looked at if + ;; time limit exhausts during traversal.) + (setf found-packages (sort found-packages #'fuzzy-matching-greaterp)) (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. + ;; The duplication filter removes all those symbols which are + ;; present in more than one package match. Specifically if such a + ;; package match represents the home package of the symbol, it's + ;; the one kept because this 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))) @@ -261,9 +266,9 @@ (* 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. + ;; Returns a filter function that takes a symbol, and which returns T + ;; if and only if /no/ matching in FUZZY-PACKAGE-MATCHINGS represents + ;; the home-package of the symbol passed. (let ((packages (mapcar #'(lambda (m) (find-package (fuzzy-matching.package-name m))) (coerce fuzzy-package-matchings 'list)))) @@ -285,7 +290,7 @@ (name2 (symbol-name (fuzzy-matching.symbol m2)))) (string< name1 name2)))))) - +(declaim (ftype (function () (integer 0)) get-real-time-msecs)) (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! Modified: branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries ============================================================================== --- branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries (original) +++ branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries Mon Jan 28 06:47:40 2008 @@ -1,9 +1,9 @@ -/.cvsignore/1.1/Thu Oct 11 14:10:24 2007// -/Makefile/1.12/Thu Oct 11 14:10:24 2007// -/slime-refcard.pdf/1.1/Thu Oct 11 14:10:24 2007// -/slime-refcard.tex/1.1/Thu Oct 11 14:10:24 2007// -/slime-small.eps/1.1/Thu Oct 11 14:10:24 2007// -/slime-small.pdf/1.1/Thu Oct 11 14:10:24 2007// -/texinfo-tabulate.awk/1.2/Thu Oct 11 14:10:24 2007// -/slime.texi/1.61/Sun Dec 2 04:22:10 2007// +/.cvsignore/1.1/Mon Jul 24 14:13:23 2006// +/Makefile/1.12/Sun Jan 27 22:03:22 2008// +/slime-refcard.pdf/1.1/Sun Jan 27 22:03:22 2008// +/slime-refcard.tex/1.1/Sun Jan 27 22:03:22 2008// +/slime-small.eps/1.1/Sun Jan 27 22:03:22 2008// +/slime-small.pdf/1.1/Sun Jan 27 22:03:22 2008// +/slime.texi/1.64/Sun Jan 27 22:03:22 2008// +/texinfo-tabulate.awk/1.2/Sun Jan 27 22:03:22 2008// D Modified: branches/trunk-reorg/thirdparty/slime/doc/slime.texi ============================================================================== --- branches/trunk-reorg/thirdparty/slime/doc/slime.texi (original) +++ branches/trunk-reorg/thirdparty/slime/doc/slime.texi Mon Jan 28 06:47:40 2008 @@ -12,7 +12,7 @@ @set EDITION 3.0-alpha @set SLIMEVER 3.0-alpha @c @set UPDATED @today{} -@set UPDATED @code{$Date: 2007/11/27 13:16:52 $} +@set UPDATED @code{$Date: 2008/01/20 16:57:49 $} @set TITLE SLIME User Manual @settitle @value{TITLE}, version @value{EDITION} @@ -1347,7 +1347,7 @@ @c @kbditem{C-c M-g, slime-quit} @c Quit slime. -@kbditem{C-c C-t, slime-repl-clear-buffer} +@kbditem{C-c M-o, slime-repl-clear-buffer} Clear the entire buffer, leaving only a prompt. @kbditem{C-c C-o, slime-repl-clear-output} @@ -2188,7 +2188,7 @@ @node Contributed Packages @chapter Contributed Packages -In version 3.0 we moved some functionility to separate packages. This +In version 3.0 we moved some functionality to separate packages. This chapter tells you how to load contrib modules and describes what the particular packages do. @@ -2237,7 +2237,7 @@ available. @node Compound Completion -@section Compund Completion +@section Compound Completion @anchor{slime-complete-symbol*} The package @code{slime-c-p-c} provides a different symbol completion @@ -2270,14 +2270,40 @@ @code{slime-c-p-c-unambiguous-prefix-p} is nil, point moves to the end of the inserted text, after the @code{o} in this case. +In addition, @code{slime-c-p-c} provides completion for character names +(mostly useful for Unicode-aware implementations): + +@example +CL-USER> #\Sp<TAB> +@end example + +Here SLIME will usually complete the character to @code{#\Space}, but +in a Unicode-aware implementation, this might provide the following completions: +@example +Space Space +Sparkle Spherical_Angle +Spherical_Angle_Opening_Left Spherical_Angle_Opening_Up +@end example + +The package @code{slime-c-p-c} also provides context-sensitive completion for keywords. +Example: + +@example +CL-USER> (find 1 '(1 2 3) :s<TAB> +@end example + +Here SLIME will complete @code{:start}, rather than suggesting all +ever-interned keywords starting with @code{:s}. + + @table @kbd @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 -@code{defmethod}. Examples: +functions and for handling @code{make-instance}, +@code{defmethod}, and many other functions. Examples: @example (subseq "abc" <C-c C-s> @@ -2472,26 +2498,138 @@ Right-clicking on the text brings up a menu with operations for the particular object. Some operations, like inspecting, are available for all objects, but the object may also have specialized operations. -E.g. pathnames have a dired operation. +For instance, pathnames have a dired operation. + +More importantly, it is possible to cut and paste presentations (i.e., +Lisp objects, not just their printed presentation), using all standard +Emacs commands. This way it is possible to cut and paste the results of +previous computations in the REPL. This is of particular importance for +unreadable objects. The package @code{slime-presentations} installs presentations in the -REPL, i.e. the results of evaluation commands become presentations. +REPL, i.e. the results of evaluation commands become presentations. In +this way, presentations generalize the use of the standard Common Lisp +REPL history variables @code{*}, @code{**}, @code{***}. Example: + +@example +CL-USER> (find-class 'standard-class) +@emph{#<STANDARD-CLASS STANDARD-CLASS>} +CL-USER> +@end example + +Presentations appear in red color in the buffer. +(In this manual, we indicate the presentations @emph{like this}.) +Using standard Emacs +commands, the presentation can be copied to a new input in the REPL: + +@example +CL-USER> (eql '@emph{#<STANDARD-CLASS STANDARD-CLASS>} '@emph{#<STANDARD-CLASS STANDARD-CLASS>}) +@emph{T} +@end example + +When you copy an incomplete presentation or edit the text within a +presentation, the presentation changes to plain text, losing the +association with a Lisp object. In the buffer, this is indicated by +changing the color of the text from red to black. This can be undone. + +Presentations are also available in the inspector (all inspectable parts +are presentations) and the debugger (all local variables are +presentations). This makes it possible to evaluate expressions in the +REPL using objects that appear in local variables of some active +debugger frame; this can be more convenient than using @code{M-x +sldb-eval-in-frame}. @strong{Warning:} The presentations that stem from +the inspector and debugger are only valid as long as the corresponding +buffers are open. Using them later can cause errors or confusing +behavior. + +For some Lisp implementations you can also install the package +@code{slime-presentation-streams}, which enables presentations on the +Lisp @code{*standard-output*} stream and similar streams. This means +that not only results +of computations, but also some objects that are printed to the standard +output (as a side-effect of the computation) are associated with +presentations. Currently, all unreadable objects +and pathnames get printed as presentations. + +@example +CL-USER> (describe (find-class 'standard-object)) +@emph{#<STANDARD-CLASS STANDARD-OBJECT>} is an instance of + @emph{#<STANDARD-CLASS STANDARD-CLASS>}: + The following slots have :INSTANCE allocation: + PLIST NIL + FLAGS 1 + DIRECT-METHODS ((@emph{#<STANDARD-METHOD + SWANK::ALL-SLOTS-FOR-INSPECTOR + (STANDARD-OBJECT T)>} + ... +@end example + +Again, this makes it possible to inspect and copy-paste these objects. + +In addition to the standard Emacs commands, there are several keyboard +commands, a menu-bar menu, and a context menu to operate on +presentations. We describe the keyboard commands below; they are also +shown in the menu-bar menu. + +@table @kbd +@kbditem{C-c C-v SPC, slime-mark-presentation} +If point is within a presentation, move point to the beginning of the +presentation and mark to the end of the presentation. +This makes it possible to copy the presentation. + +@kbditem{C-c C-v w, slime-copy-presentation-at-point-to-kill-ring} +If point is within a presentation, copy the surrounding presentation +to the kill ring. + +@kbditem{C-c C-v r, slime-copy-presentation-at-point-to-repl} +If point is within a presentation, copy the surrounding presentation +to the REPL. + +@kbditem{C-c C-v d, slime-describe-presentation-at-point} +If point is within a presentation, describe the associated object. + +@kbditem{C-c C-v i, slime-inspect-presentation-at-point} +If point is within a presentation, inspect the associated object with +the SLIME inspector. + +@kbditem{C-c C-v n, slime-next-presentation} +Move point to the next presentation in the buffer. + +@kbditem{C-c C-v p, slime-previous-presentation} +Move point to the previous presentation in the buffer. -For some implementations you can also install -@code{slime-presentation-streams} which enables presentations on the -Lisp @code{*standard-output*} stream. E.g. printing a list to such a -stream will create presentions in the Emacs buffer. - -@table @kbd -@cmditem{slime-copy-or-inspect-presentation-at-mouse} -@cmditem{slime-inspect-presentation-at-mouse} -@cmditem{slime-copy-presentation-at-mouse} -@cmditem{slime-copy-presentation-at-mouse-to-point} -@cmditem{slime-copy-presentation-at-mouse-to-kill-ring} -@cmditem{slime-describe-presentation-at-mouse} -@cmditem{slime-pretty-print-presentation-at-mouse} -@cmditem{slime-clear-presentations} @end table +Similar operations are also possible from the context menu of every +presentation. Using @kbd{mouse-3} on a presentation, the context menu +opens and offers various commands. For some objects, specialized +commands are also offered. Users can define additional specialized +commands by defining a method for +@code{swank::menu-choices-for-presentation}. + + +@strong{Warning:} On Lisp implementations without weak hash tables, +all objects associated with presentations are protected from garbage +collection. If your Lisp image grows too large because of that, +use @kbd{C-c C-v M-o} (@code{slime-clear-presentations}) to remove these +associations. You can also use the command @kbd{C-c M-o} +(@code{slime-repl-clear-buffer}), which both clears the REPL buffer and +removes all associations of objects with presentations. + +@strong{Warning:} Presentations can confuse new users. + +@example +CL-USER> (cons 1 2) +@emph{(1 . 2)} +CL-USER> (eq '@emph{(1 . 2)} '@emph{(1 . 2)}) +@emph{T} +@end example + +One could have expected @code{NIL} here, because it looks like two +fresh cons cells are compared regarding object identity. +However, in the example the presentation @code{@emph{(1 . 2)}} was copied twice +to the REPL. Thus @code{EQ} is really invoked with the same object, +namely the cons cell that was returned by the first form entered in the +REPL. @node Typeout frames @section Typeout frames Modified: branches/trunk-reorg/thirdparty/slime/slime.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/slime.el (original) +++ branches/trunk-reorg/thirdparty/slime/slime.el Mon Jan 28 06:47:40 2008 @@ -495,9 +495,9 @@ (t name)))) (format "%s" (read name)))) -(defun slime-pretty-current-package () - "Retrun a prettied version of `slime-current-package'." - (let ((p (slime-current-package))) +(defun slime-pretty-find-buffer-package () + "Return a prettied version of `slime-find-buffer-package'." + (let ((p (slime-find-buffer-package))) (and p (slime-pretty-package-name p)))) (when slime-update-modeline-package @@ -1179,7 +1179,9 @@ (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)))) + (slime-start* (cond ((and command (symbolp command)) + (slime-lisp-options command)) + (t (slime-read-interactive-args)))))) (defvar slime-inferior-lisp-program-history '() "History list of command strings. Used by `slime'.") @@ -2695,10 +2697,11 @@ (when (< slime-repl-input-start-mark (point)) (set-marker slime-repl-input-start-mark (point)))))) -(defun slime-repl-emit-result (string) +(defun slime-repl-emit-result (string &optional bol) ;; insert STRING and mark it as evaluation result (with-current-buffer (slime-output-buffer) (goto-char slime-repl-input-start-mark) + (when (and bol (not (bolp))) (insert "\n")) (slime-insert-propertized `(face slime-repl-result-face rear-nonsticky (face)) string) @@ -2873,7 +2876,8 @@ ("\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\M-o" 'slime-repl-clear-buffer) + ("\C-c\C-t" 'slime-toggle-trace-fdefinition) ("\C-c\C-u" 'slime-repl-kill-input) ("\C-c\C-n" 'slime-repl-next-prompt) ("\C-c\C-p" 'slime-repl-previous-prompt) @@ -2945,14 +2949,11 @@ (when result (destructure-case result ((:values &rest strings) - (unless (bolp) (insert "\n")) (cond ((null strings) - (insert "; No value\n")) + (slime-repl-emit-result "; No value\n" t)) (t - (dolist (string strings) - (slime-propertize-region `(face slime-repl-result-face) - (insert string)) - (insert "\n"))))))) + (dolist (s strings) + (slime-repl-emit-result s t))))))) (slime-repl-insert-prompt))) (defun slime-repl-show-abort () @@ -3312,7 +3313,7 @@ (defun slime-repl-set-package (package) "Set the package of the REPL buffer to PACKAGE." (interactive (list (slime-read-package-name - "Package: " (slime-pretty-current-package)))) + "Package: " (slime-pretty-find-buffer-package)))) (with-current-buffer (slime-output-buffer) (let ((unfinished-input (slime-repl-current-input))) (destructuring-bind (name prompt-string) @@ -5868,7 +5869,8 @@ (defun slime-apropos (string &optional only-external-p package case-sensitive-p) - "Show all bound symbols whose names match STRING, a regular expression." + "Show all bound symbols whose names match STRING. With prefix +arg, you're interactively asked for parameters of the search." (interactive (if current-prefix-arg (list (read-string "SLIME Apropos: ") @@ -5888,7 +5890,7 @@ (lambda (r) (slime-show-apropos r string package summary)))))) (defun slime-apropos-all () - "Shortcut for (slime-apropos <pattern> nil nil)" + "Shortcut for (slime-apropos <string> nil nil)" (interactive) (slime-apropos (read-string "SLIME Apropos: ") nil nil)) @@ -5931,10 +5933,7 @@ (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)) + (slime-insert-propertized `(face ,apropos-symbol-face) designator)) (terpri) (let ((apropos-label-properties slime-apropos-label-properties)) (loop for (prop namespace) @@ -6080,15 +6079,23 @@ (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")))) + do (insert " - " (slime-insert-xref-location location) "\n")))) ;; Remove the final newline to prevent accidental window-scrolling (backward-char 1) (delete-char 1)) +(defun slime-insert-xref-location (location) + (if (eql :location (car location)) + (cond ((assoc :file (cdr location)) + (second (assoc :file (cdr location)))) + ((assoc :buffer (cdr location)) + (let* ((name (second (assoc :buffer (cdr location)))) + (buffer (get-buffer name))) + (if buffer + (format "%S" buffer) + (format "%s (previously existing buffer)" name))))) + "file unknown")) + (defvar slime-next-location-function nil "Function to call for going to the next location.") @@ -6287,9 +6294,7 @@ ("*SLIME macroexpansion*" :mode lisp-mode :reusep t) package (slime-macroexpansion-minor-mode) (erase-buffer) - (save-excursion - (insert expansion)) - (indent-sexp) + (insert expansion) (font-lock-fontify-buffer)))))) (defun slime-eval-macroexpand-inplace (expander) @@ -6318,59 +6323,7 @@ (indent-sexp) (goto-char point)))))))) -(defun slime-enclosing-macro-context-establishers () - (flet ((establishes-context-p (form-spec) - (let ((operator-name (first form-spec))) - (when (stringp operator-name) - (let ((symbol-name (slime-cl-symbol-name operator-name))) - (or (equal symbol-name "macrolet") (equal symbol-name "symbol-macrolet"))))))) - (multiple-value-bind (form-specs indices points) - (slime-enclosing-form-specs) - (loop for form-spec in form-specs - for index in indices - for point in points - when (establishes-context-p form-spec) - collect form-spec into form-specs* and - collect index into indices* and - collect point into points* - finally (return (values form-specs* indices* points*)))))) - -(defun slime-collect-macro-context () - (multiple-value-bind (form-specs indices points) - (slime-enclosing-macro-context-establishers) - (save-excursion - (let ((context)) - (cl-mapc #'(lambda (form-spec index point) - (when (= index 2) - (destructuring-bind (operator-name) form-spec - (goto-char point) - (slime-forward-sexp) - (forward-char) - (push (cons operator-name (slime-parse-sexp-at-point 1 t)) context)))) - form-specs indices points) - context)))) - -(defun slime-rebuild-macro-context-around-string (string context) - (if (null context) - string - (destructuring-bind (let-operator . bindings) (first context) - (format "(%s %s %s)" let-operator bindings - (slime-rebuild-macro-context-around-string string (rest context)))))) - -(defun slime-macroexpand-locally-1 (&optional repeatedly) - (interactive "P") - (let ((sexp (first (slime-sexp-at-point-for-macroexpansion))) - (macro-context (slime-collect-macro-context))) - (if repeatedly - (slime-eval-macroexpand 'swank:swank-macroexpand-locally - (slime-rebuild-macro-context-around-string - (format "(swank::macroexpand-locally %s)" sexp) - macro-context)) - (slime-eval-macroexpand 'swank:swank-macroexpand-locally-1 - (slime-rebuild-macro-context-around-string - (format "(swank::macroexpand-locally-1 %s)" sexp) - macro-context))))) - + (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 @@ -6440,8 +6393,8 @@ (message "Connection closed."))) (defun slime-set-package (package) - (interactive (list (slime-read-package-name "Package: " - (slime-pretty-current-package)))) + (interactive (list (slime-read-package-name + "Package: " (slime-pretty-find-buffer-package)))) (message "*package*: %s" (slime-eval `(swank:set-package ,package)))) (defun slime-set-default-directory (directory) @@ -7105,6 +7058,8 @@ (destructuring-bind (start end) (sldb-frame-region) (list start end frame locals catches)))) +(defvar sldb-insert-frame-variable-value-function 'sldb-insert-frame-variable-value) + (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." @@ -7117,7 +7072,11 @@ (in-sldb-face local-name (concat name (if (zerop id) "" (format "#%d" id)))) " = ") - (insert (in-sldb-face local-value value) "\n"))))) + (funcall sldb-insert-frame-variable-value-function value frame i) + (insert "\n"))))) + +(defun sldb-insert-frame-variable-value (value frame index) + (insert (in-sldb-face local-value value))) (defun sldb-hide-frame-details () ;; delete locals and catch tags, but keep the function name and args. @@ -7329,19 +7288,17 @@ (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))))))) + (let ((threads (slime-eval '(swank:list-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) @@ -7550,6 +7507,8 @@ (defmacro slime-inspector-fontify (face string) `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string)) +(defvar slime-inspector-insert-ispec-function 'slime-inspector-insert-ispec) + (defun slime-open-inspector (inspected-parts &optional point) "Display INSPECTED-PARTS in a new inspector window. Optionally set point to POINT." @@ -7557,21 +7516,19 @@ (setq slime-buffer-connection (slime-current-connection)) (let ((inhibit-read-only t)) (erase-buffer) - (destructuring-bind (&key string-representation id title content) inspected-parts + (destructuring-bind (&key id title content) inspected-parts (macrolet ((fontify (face string) `(slime-inspector-fontify ,face ,string))) (slime-propertize-region (list 'slime-part-number id 'mouse-face 'highlight 'face 'slime-inspector-value-face) - (insert string-representation)) - (insert ":\n ") - (insert (fontify topline title)) + (insert title)) (while (eq (char-before) ?\n) (backward-delete-char 1)) (insert "\n" (fontify label "--------------------") "\n") (save-excursion - (mapc #'slime-inspector-insert-ispec content)) + (mapc slime-inspector-insert-ispec-function content)) (pop-to-buffer (current-buffer)) (when point (check-type point cons) @@ -7870,7 +7827,6 @@ (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) @@ -8481,6 +8437,9 @@ (defun slime-wait-condition (name predicate timeout) (let ((end (time-add (current-time) (seconds-to-time timeout)))) (while (not (funcall predicate)) + (let ((now (current-time))) + (message "waiting for condition: %s [%s.%06d]" name + (format-time-string "%H:%M:%S" now) (third now))) (cond ((time-less-p end (current-time)) (error "Timeout waiting for condition: %S" name)) (t @@ -8666,7 +8625,10 @@ (cl-user::bar)) " - (cl-user::bar))) + (cl-user::bar)) + ("(defun foo () + #+#.'(:and) (/ 1 0))" + (/ 1 0))) (slime-check-top-level) (with-temp-buffer (lisp-mode) @@ -8698,9 +8660,9 @@ (sldb-quit) ;; Going down - enter another recursive debug ;; Recursively debug. - (slime-eval-async 'no-such-variable))))))) + (slime-eval-async '(error)))))))) (let ((sldb-hook (cons debug-hook sldb-hook))) - (slime-eval-async 'no-such-variable) + (slime-eval-async '(error)) (slime-sync-to-top-level 5) (slime-check-top-level) (slime-check ("Maximum depth reached (%S) is %S." @@ -9013,24 +8975,31 @@ (not (not (get-buffer-window (current-buffer))))))) (def-slime-test break - () + (times) "Test if BREAK invokes SLDB." - '(()) + '((1) (2) (3)) (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-compile-string + (prin1-to-string `(defun cl-user::foo () + (dotimes (i ,times) + (break) + (sleep 0.2)))) + 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) + (dotimes (i times) + (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 "sldb closed" + (lambda () (not (sldb-get-default-buffer))) + 0.2)) (slime-sync-to-top-level 5)) (def-slime-test interrupt-at-toplevel @@ -9129,21 +9098,6 @@ (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) @@ -9241,6 +9195,32 @@ (when (featurep 'xemacs) (require 'overlay)) +(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)) + +(defun slime-delete-and-extract-region (start end) + "Like `delete-and-extract-region' except that it is guaranteed +to return a string. At least Emacs 21.3.50 returned `nil' on +\(delete-and-extract-region (point) (point)), this function +will return \"\"." + (let ((result (delete-and-extract-region start end))) + (if (null result) + "" + (assert (stringp result)) + result))) + (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 Modified: branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp Mon Jan 28 06:47:40 2008 @@ -157,6 +157,19 @@ (typecase name (generic-function (clos::generic-function-lambda-list name)) + (compiled-function + ; most of the compiled functions have an Args: line in their docs + (with-input-from-string (s (or + (si::get-documentation + (si:compiled-function-name name) 'function) + "")) + (do ((line (read-line s nil) (read-line s nil))) + ((not line) :not-available) + (ignore-errors + (if (string= (subseq line 0 6) "Args: ") + (return-from nil + (read-from-string (subseq line 6)))))))) + ; (function (let ((fle (function-lambda-expression name))) (case (car fle) @@ -241,6 +254,210 @@ (defimplementation make-default-inspector () (make-instance 'ecl-inspector)) +(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) + ; ecl clos support leaves some to be desired + (cond + ((streamp o) + (values + (format nil "~S is an ordinary stream" o) + (append + (list + "Open for " + (cond + ((ignore-errors (interactive-stream-p o)) "Interactive") + ((and (input-stream-p o) (output-stream-p o)) "Input and output") + ((input-stream-p o) "Input") + ((output-stream-p o) "Output")) + `(:newline) `(:newline)) + (label-value-line* + ("Element type" (stream-element-type o)) + ("External format" (stream-external-format o))) + (ignore-errors (label-value-line* + ("Broadcast streams" (broadcast-stream-streams o)))) + (ignore-errors (label-value-line* + ("Concatenated streams" (concatenated-stream-streams o)))) + (ignore-errors (label-value-line* + ("Echo input stream" (echo-stream-input-stream o)))) + (ignore-errors (label-value-line* + ("Echo output stream" (echo-stream-output-stream o)))) + (ignore-errors (label-value-line* + ("Output String" (get-output-stream-string o)))) + (ignore-errors (label-value-line* + ("Synonym symbol" (synonym-stream-symbol o)))) + (ignore-errors (label-value-line* + ("Input stream" (two-way-stream-input-stream o)))) + (ignore-errors (label-value-line* + ("Output stream" (two-way-stream-output-stream o))))))) + (t + (let* ((cl (si:instance-class o)) + (slots (clos:class-slots cl))) + (values (format nil "~S is an instance of class ~A" + o (clos::class-name cl)) + (loop for x in slots append + (let* ((name (clos:slot-definition-name x)) + (value (clos::slot-value o name))) + (list + (format nil "~S: " name) + `(:value ,value) + `(:newline))))))))) + ;;;; Definitions (defimplementation find-definitions (name) nil) + +;;;; Threads + +#+threads +(progn + (defvar *thread-id-counter* 0) + + (defvar *thread-id-counter-lock* + (mp:make-lock :name "thread id counter lock")) + + (defun next-thread-id () + (mp:with-lock (*thread-id-counter-lock*) + (incf *thread-id-counter*))) + + (defparameter *thread-id-map* (make-hash-table)) + + (defvar *thread-id-map-lock* + (mp:make-lock :name "thread id map lock")) + + ; ecl doesn't have weak pointers + (defimplementation spawn (fn &key name) + (let ((thread (mp:make-process :name name)) + (id (next-thread-id))) + (mp:process-preset + thread + #'(lambda () + (unwind-protect + (mp:with-lock (*thread-id-map-lock*) + (setf (gethash id *thread-id-map*) thread)) + (funcall fn) + (mp:with-lock (*thread-id-map-lock*) + (remhash id *thread-id-map*))))) + (mp:process-enable thread))) + + (defimplementation thread-id (thread) + (block thread-id + (mp:with-lock (*thread-id-map-lock*) + (loop for id being the hash-key in *thread-id-map* + using (hash-value thread-pointer) + do (if (eq thread thread-pointer) + (return-from thread-id id)))))) + + (defimplementation find-thread (id) + (mp:with-lock (*thread-id-map-lock*) + (gethash id *thread-id-map*))) + + (defimplementation thread-name (thread) + (mp:process-name thread)) + + (defimplementation thread-status (thread) + (if (mp:process-active-p thread) + "RUNNING" + "STOPPED")) + + (defimplementation make-lock (&key name) + (mp:make-lock :name name)) + + (defimplementation call-with-lock-held (lock function) + (declare (type function function)) + (mp:with-lock (lock) (funcall function))) + + (defimplementation make-recursive-lock (&key name) + (mp:make-lock :name name)) + + (defimplementation call-with-recursive-lock-held (lock function) + (declare (type function function)) + (mp:with-lock (lock) (funcall function))) + + (defimplementation current-thread () + mp:*current-process*) + + (defimplementation all-threads () + (mp:all-processes)) + + (defimplementation interrupt-thread (thread fn) + (mp:interrupt-process thread fn)) + + (defimplementation kill-thread (thread) + (mp:process-kill thread)) + + (defimplementation thread-alive-p (thread) + (mp:process-active-p thread)) + + (defvar *mailbox-lock* (mp:make-lock :name "mailbox lock")) + + (defstruct (mailbox (:conc-name mailbox.)) + (mutex (mp:make-lock :name "process mailbox")) + (queue '() :type list)) + + (defun mailbox (thread) + "Return THREAD's mailbox." + (mp: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)) + (mutex (mailbox.mutex mbox))) + (mp:interrupt-process + thread + (lambda () + (mp:with-lock (mutex) + (setf (mailbox.queue mbox) + (nconc (mailbox.queue mbox) (list message)))))))) + + (defimplementation receive () + (block got-mail + (let* ((mbox (mailbox mp:*current-process*)) + (mutex (mailbox.mutex mbox))) + (loop + (mp:with-lock (mutex) + (if (mailbox.queue mbox) + (return-from got-mail (pop (mailbox.queue mbox))))) + ;interrupt-process will halt this if it takes longer than 1sec + (sleep 1))))) + + ;; 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* + (spawn #'flush-streams + :name "auto-flush-thread")))))) + + (defmethod stream-finish-output ((stream stream)) + (finish-output stream)) + + (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 #'stream-finish-output *auto-flush-streams*))) + (sleep *auto-flush-interval*))) + + ) + Modified: branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp Mon Jan 28 06:47:40 2008 @@ -236,8 +236,9 @@ (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))) + (when 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) @@ -831,16 +832,19 @@ (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)) + (*readtable* (guess-readtable-for-filename filename)) (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)))))) + (with-debootstrapping + (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))) + (namestring (truename (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 Modified: branches/trunk-reorg/thirdparty/slime/swank-scl.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-scl.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-scl.lisp Mon Jan 28 06:47:40 2008 @@ -53,7 +53,8 @@ (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))) + (setf (slot-value (slot-value stream 'lisp::stream) 'lisp::timeout) + timeout))) ;;;;; Sockets @@ -87,7 +88,8 @@ :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) #\?) + (setf (lisp::character-conversion-stream-input-error-value stream) #\?) + (setf (lisp::character-conversion-stream-output-error-value stream) #\?) stream))  Modified: branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-source-path-parser.lisp Mon Jan 28 06:47:40 2008 @@ -56,20 +56,8 @@ (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 @@ -90,8 +78,7 @@ (let ((*read-suppress* t)) (dotimes (i n) (read stream))) - (let ((*read-suppress* nil) - (*read-eval* nil)) + (let ((*read-suppress* nil)) (read-and-record-source-map stream))) (defun source-path-stream-position (path stream) Modified: branches/trunk-reorg/thirdparty/slime/swank.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank.lisp Mon Jan 28 06:47:40 2008 @@ -78,8 +78,7 @@ "Abbreviate dotted package names to their last component if T.") (defvar *swank-io-package* - (let ((package (or (find-package :swank-io-package) - (make-package :swank-io-package :use '())))) + (let ((package (make-package :swank-io-package :use '()))) (import '(nil t quote) package) package)) @@ -1582,7 +1581,7 @@ compound forms like lists or vectors.)" (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string) (if found? - (values symbol nil) + (values symbol (length string) nil) (multiple-value-bind (sexp pos) (read-from-string string) (values sexp pos (when (symbolp sexp) @@ -2402,22 +2401,6 @@ (let ((*print-readably* nil)) (disassemble (fdefinition (from-string name))))))) -(defslimefun swank-macroexpand-locally (string) - (apply-macro-expander #'eval string)) - -(defslimefun swank-macroexpand-locally-1 (string) - (apply-macro-expander #'eval string)) - -(defmacro macroexpand-locally (form &environment env) - (multiple-value-bind (expansion expanded-p) - (macroexpand form env) - `(values ',expansion ',expanded-p))) - -(defmacro macroexpand-locally-1 (form &environment env) - (multiple-value-bind (expansion expanded-p) - (macroexpand-1 form env) - `(values ',expansion ',expanded-p))) -  ;;;; Simple completion @@ -2984,11 +2967,10 @@ (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 - :string-representation - (with-output-to-string (stream) - (print-unreadable-object (object stream :type t :identity t))) + (multiple-value-bind (_ content) (inspect-for-emacs object inspector) + (declare (ignore _)) + (list :title (with-output-to-string (s) + (print-unreadable-object (object s :type t :identity t))) :id (assign-index object *inspectee-parts*) :content (inspector-content-for-emacs content)))))