Author: hhubner Date: Thu Feb 7 03:32:58 2008 New Revision: 2452 Removed: branches/trunk-reorg/thirdparty/slime/CVS/Entries.Log 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/swank-arglists.lisp branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp branches/trunk-reorg/thirdparty/slime/doc/CVS/Entries branches/trunk-reorg/thirdparty/slime/slime-autoloads.el branches/trunk-reorg/thirdparty/slime/slime.el branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp branches/trunk-reorg/thirdparty/slime/swank-backend.lisp branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp branches/trunk-reorg/thirdparty/slime/swank-corman.lisp branches/trunk-reorg/thirdparty/slime/swank-ecl.lisp branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp branches/trunk-reorg/thirdparty/slime/swank-loader.lisp branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp branches/trunk-reorg/thirdparty/slime/swank-sbcl.lisp branches/trunk-reorg/thirdparty/slime/swank-scl.lisp branches/trunk-reorg/thirdparty/slime/swank.lisp Log: delete unwanted file Modified: branches/trunk-reorg/thirdparty/slime/CVS/Entries ============================================================================== --- branches/trunk-reorg/thirdparty/slime/CVS/Entries (original) +++ branches/trunk-reorg/thirdparty/slime/CVS/Entries Thu Feb 7 03:32:58 2008 @@ -1,35 +1,35 @@ D/contrib//// D/doc//// -/.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// +/.cvsignore/1.5/Thu Oct 11 14:10:25 2007// +/ChangeLog/1.1282/Thu Feb 7 08:07:30 2008// +/HACKING/1.8/Thu Oct 11 14:10:25 2007// +/NEWS/1.9/Sun Dec 2 04:22:09 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.4/Thu Feb 7 08:07:30 2008// +/slime.el/1.901/Thu Feb 7 08:07:31 2008// +/swank-abcl.lisp/1.45/Thu Feb 7 08:07:31 2008// +/swank-allegro.lisp/1.99/Thu Feb 7 08:07:31 2008// +/swank-backend.lisp/1.127/Thu Feb 7 08:07:31 2008// +/swank-clisp.lisp/1.65/Thu Feb 7 08:07:31 2008// +/swank-cmucl.lisp/1.176/Thu Feb 7 08:07:31 2008// +/swank-corman.lisp/1.13/Thu Feb 7 08:07:31 2008// +/swank-ecl.lisp/1.12/Thu Feb 7 08:07:31 2008// +/swank-gray.lisp/1.10/Thu Oct 11 14:10:25 2007// +/swank-lispworks.lisp/1.94/Thu Feb 7 08:07:31 2008// +/swank-loader.lisp/1.77/Thu Feb 7 08:07:31 2008// +/swank-openmcl.lisp/1.122/Thu Feb 7 08:07:31 2008// +/swank-sbcl.lisp/1.189/Thu Feb 7 08:07:31 2008// +/swank-scl.lisp/1.15/Thu Feb 7 08:07:31 2008// +/swank-source-file-cache.lisp/1.8/Thu Oct 11 14:10:25 2007// +/swank-source-path-parser.lisp/1.18/Thu Feb 7 07:59:36 2008// +/swank.asd/1.5/Thu Oct 11 14:10:25 2007// +/swank.lisp/1.527/Thu Feb 7 08:07:31 2008// +/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// Modified: branches/trunk-reorg/thirdparty/slime/ChangeLog ============================================================================== --- branches/trunk-reorg/thirdparty/slime/ChangeLog (original) +++ branches/trunk-reorg/thirdparty/slime/ChangeLog Thu Feb 7 03:32:58 2008 @@ -1,7 +1,73 @@ +2008-02-05 Marco Baringer <mb@bese.it> + + * slime.el (slime-search-buffer-package): Ask the lisp to read the + in-package form so that we properly deal with #+foo and |WHATEVER| + package names. + (slime-repl-set-package): Only prompt with a default package if + the repl's package is different from the current package. + +2008-02-04 Marco Baringer <mb@bese.it> + + * swank-openmcl.lisp (ccl::advise ccl::break): advise the + lower-level ccl::cbreak-loop instead of cl:break. + (frame-locals): If the value is a value-cell (a closed over value) + show the closed over value and not the value cell. + (disassemble-frame): add in x86-64 code. + + * slime-autoloads.el (slime-setup-contribs): Add contribs + directory to load-path. + + * slime.el (slime-setup): Add contribs directory to load-path. + + * swank-abcl.lisp, swank-allegro.lisp, swank-backend.lisp, + swank-clisp.lisp, swank-cmucl.lisp, swank-corman.lisp, + swank-ecl.lisp, swank-lispworks.lisp, swank-openmcl.lisp, + swank-sbcl.lisp, swank-scl.lisp, swank.lisp, + contrib/swank-fancy-inspector.lisp: Remove second argument from + swank:inspect-for-emacs. This functionality, choosing an inspector + at runtime, was never actually used and is, now, needless + complexity. + +2008-02-04 Helmut Eller <heller@common-lisp.net> + + Simpler code to bind 0-9 in the debugger. + + * slime.el (sldb-mode-map): When binding the keys 0-9, use eval + instead of two macros. + +2008-02-04 Helmut Eller <heller@common-lisp.net> + + Move some functions to swank-arglist.lisp. + + * swank.lisp (length=, ensure-list, recursively-empty-p) + (maybecall, exactly-one-p, read-softly-from-string) + (unintern-in-home-package, valid-function-name-p): Moved to + contrib/swank-arglist.lisp. + +2008-02-03 Marco Baringer <mb@bese.it> + + * swank.lisp (*sldb-condition-printer*): New variable. + (safe-condition-message): Use the current binding + of *sldb-condition-printer* to print the condition to a string. + + * slime.el (sldb-invoke-restart-by-name): New function. Invokes a + restart by name, uses completion to read restart's name. + (slime-define-keys sldb-mode-map): Bind + sldb-invoke-restart-by-name to I in sldb buffers. + + * swank-loader.lisp: When loading swank delete all swank packages + first. This protects the lisp from broken reloads of swank. Leave + the swank-loader package so that users can set *fasl-directory* + and *source-directory* as per the documentation. + (lisp-version-string): On openmcl use the full + cl:lisp-implementation-version, ccl::*openmcl-major-version* and + ccl::*openmcl-minor-version* aren't sufficently precise to notice + changes in openmcl's cvs. + 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: @@ -15,7 +81,7 @@ (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 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 Thu Feb 7 03:32:58 2008 @@ -1,33 +1,37 @@ -/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// +/ChangeLog/1.87/Thu Feb 7 08:07:31 2008// +/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.7/Thu Feb 7 07:59:35 2008// +/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.6/Thu Feb 7 07:59:35 2008// +/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-fuzzy.el/1.6/Thu Feb 7 07:59:35 2008// +/slime-highlight-edits.el/1.3/Thu Oct 11 14:10:25 2007// +/slime-indentation.el/1.1/Sun Feb 3 18:45:14 2008// +/slime-motd.el/1.1/Sun Feb 3 18:39:23 2008// +/slime-parse.el/1.10/Thu Feb 7 07:59:35 2008// +/slime-presentation-streams.el/1.2/Thu Oct 11 14:10:25 2007// +/slime-presentations.el/1.12/Thu Feb 7 07:59:35 2008// +/slime-references.el/1.4/Thu Oct 11 14:10:25 2007// +/slime-scheme.el/1.1/Thu Feb 7 08:07:31 2008// +/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.6/Thu Feb 7 07:59:35 2008// +/slime-xref-browser.el/1.1/Thu Oct 11 14:10:25 2007// +/swank-arglists.lisp/1.20/Thu Feb 7 08:07:31 2008// +/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-fancy-inspector.lisp/1.7/Thu Feb 7 08:07:32 2008// +/swank-fuzzy.lisp/1.7/Thu Feb 7 07:59:35 2008// +/swank-goo.goo/1.1/Thu Feb 7 08:07:32 2008// +/swank-indentation.lisp/1.1/Sun Feb 3 18:45:14 2008// +/swank-kawa.scm/1.1/Thu Feb 7 08:07:32 2008// +/swank-listener-hooks.lisp/1.1/Thu Oct 11 14:10:25 2007// +/swank-motd.lisp/1.1/Sun Feb 3 18:39:23 2008// +/swank-presentation-streams.lisp/1.5/Thu Feb 7 08:07:32 2008// +/swank-presentations.lisp/1.4/Thu Oct 11 14:10:25 2007// D Modified: branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/ChangeLog Thu Feb 7 03:32:58 2008 @@ -1,7 +1,37 @@ +2008-02-04 Marco Baringer <mb@bese.it> + + * swank-presentation-streams.lisp (presenting-object-1): Add + declare special *record-repl-results* to silence compiler + warnings. + + * swank-arglists.lisp (arglist-dispatch): Specialize operator-type + so openmcl doesn't warn about unused arguments. + (arglist-dispatch): add declare ignore form. + +2008-02-04 Helmut Eller <heller@common-lisp.net> + + Move some functions to swank-arglist.lisp. + + * swank-arglist.lisp (length=, ensure-list, recursively-empty-p) + (maybecall, exactly-one-p, read-softly-from-string) + (unintern-in-home-package, valid-function-name-p): Moved from + swank.lisp. to contrib/swank-arglist.lisp. + +2008-02-03 Marco Baringer <mb@bese.it> + + * swank-motd.lisp, slime-motd.el: Message Of The Day printing for + slime. + + * slime-indentation.el: Integrate cl-indent.el into slime's + contrib infrastructure. Fix bug in &rest. + + * swank-indentation.lisp: Allow an application runnig under slime + to update emacs' indentation notes. + 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. @@ -13,7 +43,7 @@ 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> 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 Thu Feb 7 03:32:58 2008 @@ -12,6 +12,40 @@ (eval-when (:compile-toplevel :load-toplevel :execute) (swank-require :swank-c-p-c)) +(defun length= (seq n) + "Test for whether SEQ contains N number of elements. I.e. it's equivalent + to (= (LENGTH SEQ) N), but besides being more concise, it may also be more + efficiently implemented." + (etypecase seq + (list (do ((i n (1- i)) + (list seq (cdr list))) + ((or (<= i 0) (null list)) + (and (zerop i) (null list))))) + (sequence (= (length seq) n)))) + +(defun ensure-list (thing) + (if (listp thing) thing (list thing))) + +(defun recursively-empty-p (list) + "Returns whether LIST consists only of arbitrarily nested empty lists." + (cond ((not (listp list)) nil) + ((null list) t) + (t (every #'recursively-empty-p list)))) + +(defun maybecall (bool fn &rest args) + "Call FN with ARGS if BOOL is T. Otherwise return ARGS as multiple values." + (if bool (apply fn args) (values-list args))) + +(defun exactly-one-p (&rest values) + "If exactly one value in VALUES is non-NIL, this value is returned. +Otherwise NIL is returned." + (let ((found nil)) + (dolist (v values) + (when v (if found + (return-from exactly-one-p nil) + (setq found v)))) + found)) + (defun valid-operator-symbol-p (symbol) "Is SYMBOL the name of a function, a macro, or a special-operator?" (or (fboundp symbol) @@ -24,6 +58,14 @@ (let ((symbol (parse-symbol string))) (valid-operator-symbol-p symbol))) +(defun valid-function-name-p (form) + (or (symbolp form) + (and (consp form) + (second form) + (not (third form)) + (eq (first form) 'setf) + (symbolp (second form))))) + (defslimefun arglist-for-echo-area (raw-specs &key arg-indices print-right-margin print-lines) "Return the arglist for the first valid ``form spec'' in @@ -243,6 +285,29 @@ (assert (= pos (length string))) (values sexp interned?))) +(defun read-softly-from-string (string) + "Returns three values: + + 1. the object resulting from READing STRING. + + 2. The index of the first character in STRING that was not read. + + 3. T if the object is a symbol that had to be newly interned + in some package. (This does not work for symbols in + compound forms like lists or vectors.)" + (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string) + (if found? + (values symbol (length string) nil) + (multiple-value-bind (sexp pos) (read-from-string string) + (values sexp pos + (when (symbolp sexp) + (prog1 t + ;; assert that PARSE-SYMBOL didn't parse incorrectly. + (assert (and (equal symbol-name (symbol-name sexp)) + (eq package (symbol-package sexp))))))))))) + +(defun unintern-in-home-package (symbol) + (unintern symbol (symbol-package symbol))) (defstruct (arglist (:conc-name arglist.) (:predicate arglist-p)) provided-args ; list of the provided actual arguments @@ -1022,7 +1087,7 @@ (defgeneric arglist-dispatch (operator-type operator arguments &key remove-args)) -(defmethod arglist-dispatch (operator-type operator arguments &key (remove-args t)) +(defmethod arglist-dispatch ((operator-type t) operator arguments &key (remove-args t)) (when (and (symbolp operator) (valid-operator-symbol-p operator)) (multiple-value-bind (decoded-arglist determining-args any-enrichment) @@ -1075,7 +1140,7 @@ (defmethod arglist-dispatch ((operator-type (eql :function)) (operator (eql 'declare)) arguments &key (remove-args t)) ;; Catching 'DECLARE before SWANK-BACKEND:ARGLIST can barf. - (declare (ignore remove-args)) + (declare (ignore remove-args arguments)) (make-arglist :rest '#:decl-specifiers)) (defmethod arglist-dispatch ((operator-type (eql :declaration)) Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/swank-fancy-inspector.lisp Thu Feb 7 03:32:58 2008 @@ -6,12 +6,7 @@ (in-package :swank) -;; Subclass `backend-inspector' so that backend specific methods are -;; also considered. -(defclass fancy-inspector (backend-inspector) ()) - -(defmethod inspect-for-emacs ((symbol symbol) (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((symbol symbol)) (let ((package (symbol-package symbol))) (multiple-value-bind (_symbol status) (and package (find-symbol (string symbol) package)) @@ -94,8 +89,7 @@ (t (list label ": " '(:newline) " " docstring '(:newline)))))) -(defmethod inspect-for-emacs ((f function) inspector) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((f function)) (values "A function." (append (label-value-line "Name" (function-name f)) @@ -128,12 +122,11 @@ (swank-mop:method-qualifiers method) (method-specializers-for-inspect method))) -(defmethod inspect-for-emacs ((object standard-object) - (inspector fancy-inspector)) +(defmethod inspect-for-emacs ((object standard-object)) (let ((class (class-of object))) (values "An object." `("Class: " (:value ,class) (:newline) - ,@(all-slots-for-inspector object inspector))))) + ,@(all-slots-for-inspector object))))) (defvar *gf-method-getter* 'methods-by-applicability "This function is called to get the methods of a generic function. @@ -193,8 +186,8 @@ `(" " (:action "[make unbound]" ,(lambda () (swank-mop:slot-makunbound-using-class class object slot))))))))) -(defgeneric all-slots-for-inspector (object inspector) - (:method ((object standard-object) inspector) +(defgeneric all-slots-for-inspector (object) + (:method ((object standard-object)) (declare (ignore inspector)) (append '("--------------------" (:newline) "All Slots:" (:newline)) @@ -231,8 +224,7 @@ append slot-presentation collect '(:newline)))))) -(defmethod inspect-for-emacs ((gf standard-generic-function) - (inspector fancy-inspector)) +(defmethod inspect-for-emacs ((gf standard-generic-function)) (flet ((lv (label value) (label-value-line label value))) (values "A generic function." @@ -255,10 +247,9 @@ (remove-method gf m)))) (:newline))) `((:newline)) - (all-slots-for-inspector gf inspector))))) + (all-slots-for-inspector gf))))) -(defmethod inspect-for-emacs ((method standard-method) - (inspector fancy-inspector)) +(defmethod inspect-for-emacs ((method standard-method)) (values "A method." `("Method defined on the generic function " (:value ,(swank-mop:method-generic-function method) @@ -276,10 +267,9 @@ (:newline) "Method function: " (:value ,(swank-mop:method-function method)) (:newline) - ,@(all-slots-for-inspector method inspector)))) + ,@(all-slots-for-inspector method)))) -(defmethod inspect-for-emacs ((class standard-class) - (inspector fancy-inspector)) +(defmethod inspect-for-emacs ((class standard-class)) (values "A class." `("Name: " (:value ,(class-name class)) (:newline) @@ -336,10 +326,9 @@ `(:value ,(swank-mop:class-prototype class)) '"#<N/A (class not finalized)>") (:newline) - ,@(all-slots-for-inspector class inspector)))) + ,@(all-slots-for-inspector class)))) -(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition) - (inspector fancy-inspector)) +(defmethod inspect-for-emacs ((slot swank-mop:standard-slot-definition)) (values "A slot." `("Name: " (:value ,(swank-mop:slot-definition-name slot)) (:newline) @@ -353,7 +342,7 @@ "#<unspecified>") (:newline) "Init function: " (:value ,(swank-mop:slot-definition-initfunction slot)) (:newline) - ,@(all-slots-for-inspector slot inspector)))) + ,@(all-slots-for-inspector slot)))) ;; Wrapper structure over the list of symbols of a package that should @@ -445,9 +434,7 @@ (:newline) ))))) -(defmethod inspect-for-emacs ((%container %package-symbols-container) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((%container %package-symbols-container)) (with-struct (%container. title description symbols grouping-kind) %container (values title `(,@description @@ -464,10 +451,7 @@ (:newline) (:newline) ,@(make-symbols-listing grouping-kind symbols))))) - -(defmethod inspect-for-emacs ((package package) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((package package)) (let ((package-name (package-name package)) (package-nicknames (package-nicknames package)) (package-use-list (package-use-list package)) @@ -561,9 +545,7 @@ :description nil))))))) -(defmethod inspect-for-emacs ((pathname pathname) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((pathname pathname)) (values (if (wild-pathname-p pathname) "A wild pathname." "A pathname.") @@ -579,9 +561,7 @@ (not (probe-file pathname))) (label-value-line "Truename" (truename pathname)))))) -(defmethod inspect-for-emacs ((pathname logical-pathname) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((pathname logical-pathname)) (values "A logical pathname." (append (label-value-line* @@ -601,9 +581,7 @@ ("Truename" (if (not (wild-pathname-p pathname)) (probe-file pathname))))))) -(defmethod inspect-for-emacs ((n number) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((n number)) (values "A number." `("Value: " ,(princ-to-string n)))) (defun format-iso8601-time (time-value &optional include-timezone-p) @@ -626,9 +604,7 @@ year month day hour minute second include-timezone-p (format-iso8601-timezone zone))))) -(defmethod inspect-for-emacs ((i integer) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((i integer)) (values "A number." (append `(,(format nil "Value: ~D = #x~8,'0X = #o~O = #b~,,' ,8:B~@[ = ~E~]" @@ -640,26 +616,20 @@ (ignore-errors (label-value-line "Universal-time" (format-iso8601-time i t)))))) -(defmethod inspect-for-emacs ((c complex) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((c complex)) (values "A complex number." (label-value-line* ("Real part" (realpart c)) ("Imaginary part" (imagpart c))))) -(defmethod inspect-for-emacs ((r ratio) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((r ratio)) (values "A non-integer ratio." (label-value-line* ("Numerator" (numerator r)) ("Denominator" (denominator r)) ("As float" (float r))))) -(defmethod inspect-for-emacs ((f float) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((f float)) (values "A floating point number." (cond ((> f most-positive-long-float) @@ -679,9 +649,7 @@ (label-value-line "Digits" (float-digits f)) (label-value-line "Precision" (float-precision f)))))))) -(defmethod inspect-for-emacs ((stream file-stream) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((stream file-stream)) (multiple-value-bind (title content) (call-next-method) (declare (ignore title)) @@ -699,9 +667,7 @@ (:newline)) content)))) -(defmethod inspect-for-emacs ((condition stream-error) - (inspector fancy-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((condition stream-error)) (multiple-value-bind (title content) (call-next-method) (let ((stream (stream-error-stream condition))) @@ -724,14 +690,10 @@ (defvar *fancy-inpector-undo-list* nil) (defslimefun fancy-inspector-init () - (let ((i *default-inspector*)) - (push (lambda () (setq *default-inspector* i)) - *fancy-inpector-undo-list*)) - (setq *default-inspector* (make-instance 'fancy-inspector)) t) (defslimefun fancy-inspector-unload () (loop while *fancy-inpector-undo-list* do (funcall (pop *fancy-inpector-undo-list*)))) -(provide :swank-fancy-inspector) \ No newline at end of file +(provide :swank-fancy-inspector) Modified: branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/contrib/swank-presentation-streams.lisp Thu Feb 7 03:32:58 2008 @@ -210,6 +210,9 @@ (defun presenting-object-1 (object stream continue) "Uses the bridge mechanism with two messages >id and <id. The first one says that I am starting to print an object with this id. The second says I am finished" + ;; this declare special is to let the compiler know that *record-repl-results* will eventually be + ;; a global special, even if it isn't when this file is compiled/loaded. + (declare (special *record-repl-results*)) (let ((slime-stream-p (and *record-repl-results* (slime-stream-p stream)))) (if slime-stream-p 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 Thu Feb 7 03:32:58 2008 @@ -1,9 +1,9 @@ -/.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// +/.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// +/slime.texi/1.64/Thu Feb 7 07:59:33 2008// +/texinfo-tabulate.awk/1.2/Thu Oct 11 14:10:24 2007// D Modified: branches/trunk-reorg/thirdparty/slime/slime-autoloads.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/slime-autoloads.el (original) +++ branches/trunk-reorg/thirdparty/slime/slime-autoloads.el Thu Feb 7 03:32:58 2008 @@ -39,11 +39,16 @@ (defvar slime-setup-contribs nil) (defun slime-setup-contribs () - (dolist (c slime-setup-contribs) - (require c) - (let ((init (intern (format "%s-init" c)))) - (when (fboundp init) - (funcall init))))) + (when slime-setup-contribs + (pushnew (file-name-as-directory + (expand-file-name (concat slime-path "contribs"))) + load-path + :test 'string=) + (dolist (c slime-setup-contribs) + (require c) + (let ((init (intern (format "%s-init" c)))) + (when (fboundp init) + (funcall init)))))) (provide 'slime-autoloads) Modified: branches/trunk-reorg/thirdparty/slime/slime.el ============================================================================== --- branches/trunk-reorg/thirdparty/slime/slime.el (original) +++ branches/trunk-reorg/thirdparty/slime/slime.el Thu Feb 7 03:32:58 2008 @@ -71,11 +71,16 @@ CONTRIBS is a list of contrib packages to load." (when (member 'lisp-mode slime-lisp-modes) (add-hook 'lisp-mode-hook 'slime-lisp-mode-hook)) - (dolist (c contribs) - (require c) - (let ((init (intern (format "%s-init" c)))) - (when (fboundp init) - (funcall init))))) + (when contribs + (pushnew (file-name-as-directory + (expand-file-name (concat slime-path "contribs"))) + load-path + :test 'string=) + (dolist (c contribs) + (require c) + (let ((init (intern (format "%s-init" c)))) + (when (fboundp init) + (funcall init)))))) (defun slime-lisp-mode-hook () (slime-mode 1) @@ -2262,7 +2267,11 @@ (save-excursion (when (or (re-search-backward regexp nil t) (re-search-forward regexp nil t)) - (match-string-no-properties 2))))) + ;; package name can be a string designator, convert it to a string. + ;;(slime-eval `(cl:string (cl:second (cl:read-from-string ,(match-string-no-properties 0)))) + ;; "COMMON-LISP-USER") + (match-string-no-properties 2) + )))) ;;; Synchronous requests are implemented in terms of asynchronous ;;; ones. We make an asynchronous request with a continuation function @@ -3312,8 +3321,12 @@ (defun slime-repl-set-package (package) "Set the package of the REPL buffer to PACKAGE." - (interactive (list (slime-read-package-name - "Package: " (slime-pretty-find-buffer-package)))) + (interactive (list (slime-read-package-name "Package: " + (if (string= (slime-current-package) + (with-current-buffer (slime-repl-buffer) + (slime-current-package))) + nil + (slime-pretty-find-buffer-package))))) (with-current-buffer (slime-output-buffer) (let ((unfinished-input (slime-repl-current-input))) (destructuring-bind (name prompt-string) @@ -6551,6 +6564,7 @@ (">" 'sldb-end-of-backtrace) ("t" 'sldb-toggle-details) ("r" 'sldb-restart-frame) + ("I" 'sldb-invoke-restart-by-name) ("R" 'sldb-return-from-frame) ("c" 'sldb-continue) ("s" 'sldb-step) @@ -6573,23 +6587,14 @@ (define-key sldb-mode-map key command))))) ;; Keys 0-9 are shortcuts to invoke particular restarts. -(defmacro define-sldb-invoke-restart-key (number key) +(dotimes (number 10) (let ((fname (intern (format "sldb-invoke-restart-%S" number))) (docstring (format "Invoke restart numbered %S." number))) - `(progn - (defun ,fname () - ,docstring - (interactive) - (sldb-invoke-restart ,number)) - (define-key sldb-mode-map ,key ',fname)))) - -(defmacro define-sldb-invoke-restart-keys (from to) - `(progn - ,@(loop for n from from to to - collect `(define-sldb-invoke-restart-key ,n - ,(number-to-string n))))) - -(define-sldb-invoke-restart-keys 0 9) + (eval `(defun ,fname () + ,docstring + (interactive) + (sldb-invoke-restart ,number))) + (define-key sldb-mode-map (number-to-string number) fname)))  ;;;;; SLDB buffer creation & update @@ -7223,6 +7228,14 @@ ((:ok value) (message "Restart returned: %s" value)) ((:abort))))) +(defun sldb-invoke-restart-by-name (restart-name) + (interactive (list (completing-read "Restart: " + sldb-restarts nil t + "" + 'sldb-invoke-restart-by-name))) + (sldb-invoke-restart (position restart-name sldb-restarts + :test 'string= :key 'first))) + (defun sldb-break-with-default-debugger () "Enter default debugger." (interactive) Modified: branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-abcl.lisp Thu Feb 7 03:32:58 2008 @@ -421,14 +421,7 @@ ;;;; Inspecting -(defclass abcl-inspector (backend-inspector) ()) - -(defimplementation make-default-inspector () - (make-instance 'abcl-inspector)) - -(defmethod inspect-for-emacs ((slot mop::slot-definition) - (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((slot mop::slot-definition)) (values "A slot." `("Name: " (:value ,(mop::%slot-definition-name slot)) (:newline) @@ -443,8 +436,7 @@ " Function: " (:value ,(mop::%slot-definition-initfunction slot)) (:newline)))) -(defmethod inspect-for-emacs ((f function) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((f function)) (values "A function." `(,@(when (function-name f) `("Name: " @@ -461,7 +453,7 @@ #| -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) +(defmethod inspect-for-emacs ((o t)) (let* ((class (class-of o)) (slots (mop::class-slots class))) (values (format nil "~A~% is a ~A" o class) Modified: branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-allegro.lisp Thu Feb 7 03:32:58 2008 @@ -564,13 +564,7 @@ ;;;; Inspecting -(defclass acl-inspector (backend-inspector) ()) - -(defimplementation make-default-inspector () - (make-instance 'acl-inspector)) - -(defmethod inspect-for-emacs ((f function) inspector) - inspector +(defmethod inspect-for-emacs ((f function)) (values "A function." (append (label-value-line "Name" (function-name f)) @@ -579,17 +573,13 @@ (when doc `("Documentation:" (:newline) ,doc)))))) -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o t)) (values "A value." (allegro-inspect o))) -(defmethod inspect-for-emacs ((o function) (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o function)) (values "A function." (allegro-inspect o))) -(defmethod inspect-for-emacs ((o standard-object) - (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o standard-object)) (values (format nil "~A is a standard-object." o) (allegro-inspect o))) (defun allegro-inspect (o) Modified: branches/trunk-reorg/thirdparty/slime/swank-backend.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-backend.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-backend.lisp Thu Feb 7 03:32:58 2008 @@ -840,26 +840,10 @@  ;;;; Inspector -(defclass inspector () - () - (:documentation "Super class of inspector objects. - -Implementations should sub class in order to dispatch off of the -inspect-for-emacs method.")) - -(defclass backend-inspector (inspector) ()) - -(definterface make-default-inspector () - "Return an inspector object suitable for passing to inspect-for-emacs.") - -(defgeneric inspect-for-emacs (object inspector) +(defgeneric inspect-for-emacs (object) (:documentation "Explain to Emacs how to inspect OBJECT. -The argument INSPECTOR is an object representing how to get at -the internals of OBJECT, it is usually an implementation specific -class used simply for dispatching to the proper method. - Returns two values: a string which will be used as the title of the inspector buffer and a list specifying how to render the object for inspection. @@ -880,12 +864,11 @@ NIL - do nothing.")) -(defmethod inspect-for-emacs ((object t) (inspector t)) +(defmethod inspect-for-emacs ((object t)) "Generic method for inspecting any kind of object. Since we don't know how to deal with OBJECT we simply dump the output of CL:DESCRIBE." - (declare (ignore inspector)) (values "A value." `("Type: " (:value ,(type-of object)) (:newline) Modified: branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-clisp.lisp Thu Feb 7 03:32:58 2008 @@ -627,12 +627,7 @@ ;;;; Inspecting -(defclass clisp-inspector (backend-inspector) ()) - -(defimplementation make-default-inspector () (make-instance 'clisp-inspector)) - -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o t)) (let* ((*print-array* nil) (*print-pretty* t) (*print-circle* t) (*print-escape* t) (*print-lines* custom:*inspect-print-lines*) Modified: branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-cmucl.lisp Thu Feb 7 03:32:58 2008 @@ -1869,7 +1869,7 @@ :key #'symbol-value))) (format t ", type: ~A" type-symbol)))))) -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) +(defmethod inspect-for-emacs ((o t)) (cond ((di::indirect-value-cell-p o) (values (format nil "~A is a value cell." o) `("Value: " (:value ,(c:value-cell-ref o))))) @@ -1887,8 +1887,7 @@ (loop for value in parts for i from 0 append (label-value-line i value)))))) -(defmethod inspect-for-emacs ((o function) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o function)) (let ((header (kernel:get-type o))) (cond ((= header vm:function-header-type) (values (format nil "~A is a function." o) @@ -1915,9 +1914,7 @@ (t (call-next-method))))) -(defmethod inspect-for-emacs ((o kernel:funcallable-instance) - (i backend-inspector)) - (declare (ignore i)) +(defmethod inspect-for-emacs ((o kernel:funcallable-instance)) (values (format nil "~A is a funcallable-instance." o) (append (label-value-line* @@ -1926,8 +1923,7 @@ (:layout (kernel:%funcallable-instance-layout o))) (nth-value 1 (cmucl-inspect o))))) -(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector)) - (declare (ignore _)) +(defmethod inspect-for-emacs ((o kernel:code-component)) (values (format nil "~A is a code data-block." o) (append (label-value-line* @@ -1954,8 +1950,7 @@ (ash (kernel:%code-code-size o) vm:word-shift) :stream s)))))))) -(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o kernel:fdefn)) (values (format nil "~A is a fdenf object." o) (label-value-line* ("name" (kernel:fdefn-name o)) @@ -1964,8 +1959,7 @@ (sys:int-sap (kernel:get-lisp-obj-address o)) (* vm:fdefn-raw-addr-slot vm:word-bytes)))))) -(defmethod inspect-for-emacs ((o array) (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o array)) (if (typep o 'simple-array) (call-next-method) (values (format nil "~A is an array." o) @@ -1980,8 +1974,7 @@ (:displaced-p (kernel:%array-displaced-p o)) (:dimensions (array-dimensions o)))))) -(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o simple-vector)) (values (format nil "~A is a simple-vector." o) (append (label-value-line* Modified: branches/trunk-reorg/thirdparty/slime/swank-corman.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-corman.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-corman.lisp Thu Feb 7 03:32:58 2008 @@ -387,21 +387,13 @@ ;; Hack to make swank.lisp load, at least (defclass file-stream ()) -(defclass corman-inspector (backend-inspector) - ()) - -(defimplementation make-default-inspector () - (make-instance 'corman-inspector)) - (defun comma-separated (list &optional (callback (lambda (v) `(:value ,v)))) (butlast (loop for e in list collect (funcall callback e) collect ", "))) -(defmethod inspect-for-emacs ((class standard-class) - (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((class standard-class)) (values "A class." `("Name: " (:value ,(class-name class)) (:newline) @@ -438,9 +430,8 @@ '("#<N/A (class not finalized)>")) (:newline)))) -(defmethod inspect-for-emacs ((slot cons) (inspector backend-inspector)) +(defmethod inspect-for-emacs ((slot cons)) ;; Inspects slot definitions - (declare (ignore inspector)) (if (eq (car slot) :name) (values "A slot." `("Name: " (:value ,(swank-mop:slot-definition-name slot)) @@ -457,9 +448,7 @@ (:newline))) (call-next-method))) -(defmethod inspect-for-emacs ((pathname pathnames::pathname-internal) - inspector) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((pathname pathnames::pathname-internal)) (values (if (wild-pathname-p pathname) "A wild pathname." "A pathname.") @@ -475,7 +464,7 @@ (not (probe-file pathname))) (label-value-line "Truename" (truename pathname)))))) -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) +(defmethod inspect-for-emacs ((o t)) (cond ((cl::structurep o) (inspect-structure o)) (t (call-next-method)))) 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 Thu Feb 7 03:32:58 2008 @@ -248,13 +248,7 @@ ;;;; Inspector -(defclass ecl-inspector (inspector) - ()) - -(defimplementation make-default-inspector () - (make-instance 'ecl-inspector)) - -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) +(defmethod inspect-for-emacs ((o t)) ; ecl clos support leaves some to be desired (cond ((streamp o) Modified: branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-lispworks.lisp Thu Feb 7 03:32:58 2008 @@ -629,20 +629,15 @@ (defimplementation make-default-inspector () (make-instance 'lispworks-inspector)) -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o t)) (lispworks-inspect o)) -(defmethod inspect-for-emacs ((o function) - (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o function)) (lispworks-inspect o)) ;; FIXME: slot-boundp-using-class in LW works with names so we can't ;; use our method in swank.lisp. -(defmethod inspect-for-emacs ((o standard-object) - (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o standard-object)) (lispworks-inspect o)) (defun lispworks-inspect (o) Modified: branches/trunk-reorg/thirdparty/slime/swank-loader.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-loader.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-loader.lisp Thu Feb 7 03:32:58 2008 @@ -18,6 +18,12 @@ ;; (defparameter swank-loader::*fasl-directory* "/tmp/fasl/") ;; (load ".../swank-loader.lisp") +(eval-when (:compile-toplevel :load-toplevel :execute) + (when (find-package :swank) + (delete-package :swank) + (delete-package :swank-io-package) + (delete-package :swank-backend))) + (cl:defpackage :swank-loader (:use :cl) (:export :load-swank @@ -60,14 +66,9 @@ :sparc64 :sparc :hppa64 :hppa)) (defun lisp-version-string () - #+cmu (substitute-if #\_ (lambda (x) (find x " /")) + #+(or openmcl cmu) (substitute-if #\_ (lambda (x) (find x " /")) (lisp-implementation-version)) - #+scl (lisp-implementation-version) - #+sbcl (lisp-implementation-version) - #+ecl (lisp-implementation-version) - #+openmcl (format nil "~d.~d" - ccl::*openmcl-major-version* - ccl::*openmcl-minor-version*) + #+(or cormanlisp scl sbcl ecl) (lisp-implementation-version) #+lispworks (lisp-implementation-version) #+allegro (format nil "~A~A~A" @@ -76,8 +77,7 @@ (if (member :64bit *features*) "-64bit" "")) #+clisp (let ((s (lisp-implementation-version))) (subseq s 0 (position #\space s))) - #+armedbear (lisp-implementation-version) - #+cormanlisp (lisp-implementation-version)) + #+armedbear (lisp-implementation-version)) (defun unique-directory-name () "Return a name that can be used as a directory name that is Modified: branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank-openmcl.lisp Thu Feb 7 03:32:58 2008 @@ -211,14 +211,18 @@ (defvar *break-in-sldb* t) + (let ((ccl::*warn-if-redefine-kernel* nil)) - (ccl::advise - cl::break + (ccl::advise + ccl::cbreak-loop (if (and *break-in-sldb* - (find ccl::*current-process* (symbol-value (intern "*CONNECTIONS*" 'swank)) - :key (intern "CONNECTION.REPL-THREAD" 'swank))) + (find ccl::*current-process* + (symbol-value (intern (string :*connections*) :swank)) + :key (intern (string :connection.repl-thread) :swank))) (apply 'break-in-sldb ccl::arglist) - (:do-it)) :when :around :name sldb-break)) + (:do-it)) + :when :around + :name sldb-break)) (defun break-in-sldb (&optional string &rest args) (let ((c (make-condition 'simple-condition @@ -335,8 +339,7 @@ for (value nil name) = (multiple-value-list (ccl::nth-value-in-frame p count context lfun pc vsp parent-vsp)) when name do (incf varcount) until (= varcount var) - finally (return value)) - ))))))) + finally (return value))))))))) (defun xref-locations (relation name &optional (inverse nil)) (flet ((function-source-location (entry) @@ -345,8 +348,8 @@ (ccl::%db-key-from-xref-entry entry) (if (eql (ccl::xref-entry-type entry) 'macro) - 'function - (ccl::xref-entry-type entry))) + 'function + (ccl::xref-entry-type entry))) (cond ((not info) (list :error (format nil "No source info available for ~A" @@ -466,7 +469,8 @@ (setq ccl::*fasl-save-definitions* nil) (setq ccl::*fasl-save-doc-strings* t) (setq ccl::*fasl-save-local-symbols* t) - (setq ccl::*ppc2-compiler-register-save-label* t) + #+ppc (setq ccl::*ppc2-compiler-register-save-label* t) + #+x86-64 (setq ccl::*x862-compiler-register-save-label* t) (setq ccl::*save-arglist-info* t) (setq ccl::*save-definitions* nil) (setq ccl::*save-doc-strings* t) @@ -513,9 +517,8 @@ (defun frame-arguments (p context lfun pc) "Returns a string representing the arguments of a frame." - (multiple-value-bind (args types names count nclosed) + (multiple-value-bind (args types names) (ccl::frame-supplied-args p lfun pc nil context) - (declare (ignore count nclosed)) (let ((result nil)) (loop named loop for var = (cond @@ -575,7 +578,9 @@ (push (list :name name :id 0 - :value var) + :value (if (typep var 'ccl::value-cell) + (ccl::uvref var 0) + var)) result)))) (return-from frame-locals (nreverse result))))))))) @@ -610,19 +615,24 @@ (when (= frame-number the-frame-number) (setq function-to-disassemble lfun) (return-from find-frame))))) - (ccl::print-ppc-instructions - *standard-output* - (ccl::function-to-dll-header function-to-disassemble) nil))) + #+ppc (ccl::print-ppc-instructions + *standard-output* + (ccl::function-to-dll-header function-to-disassemble) + nil) + #+x86-64 (ccl::x8664-xdisassemble function-to-disassemble))) ;;; -(defun canonicalize-location (file symbol) +(defun canonicalize-location (file symbol &optional snippet) (etypecase file ((or string pathname) (multiple-value-bind (truename c) (ignore-errors (namestring (truename file))) (cond (c (list :error (princ-to-string c))) (t (make-location (list :file (remove-filename-quoting truename)) - (list :function-name (princ-to-string symbol))))))))) + (list :function-name (princ-to-string symbol)) + (if snippet + (list :snippet snippet) + '())))))))) (defun remove-filename-quoting (string) (if (search "\\" string) @@ -644,20 +654,20 @@ (list (list type symbol) (canonicalize-location file symbol)))))) - (defun function-source-location (function) - (multiple-value-bind (info name) (ccl::edit-definition-p function) + (multiple-value-bind (info name) + (ccl::edit-definition-p function) (cond ((not info) (list :error (format nil "No source info available for ~A" function))) ((typep (caar info) 'ccl::method) `(:location (:file ,(remove-filename-quoting (namestring (translate-logical-pathname (cdr (car info))) ))) (:method ,(princ-to-string (ccl::method-name (caar info))) - ,(mapcar 'princ-to-string - (mapcar #'specializer-name - (ccl::method-specializers (caar info)))) - ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info)))) + ,(mapcar 'princ-to-string + (mapcar #'specializer-name + (ccl::method-specializers (caar info)))) + ,@(mapcar 'princ-to-string (ccl::method-qualifiers (caar info)))) nil)) - (t (canonicalize-location (cdr (first info)) name))))) + (t (canonicalize-location (second (first info)) name (third (first info))))))) (defimplementation frame-source-location-for-emacs (index) "Return to Emacs the location of the source code for the @@ -693,6 +703,7 @@ ,form))) ))))))) +#+ppc (defimplementation return-from-frame (index form) (let ((values (multiple-value-list (eval-in-frame form index)))) (map-backtrace @@ -700,7 +711,8 @@ (declare (ignore context lfun pc)) (when (= frame-number index) (ccl::apply-in-frame p #'values values)))))) - + +#+ppc (defimplementation restart-frame (index) (map-backtrace (lambda (frame-number p context lfun pc) @@ -784,19 +796,13 @@ ;;;; Inspection -(defclass openmcl-inspector (backend-inspector) ()) - -(defimplementation make-default-inspector () - (make-instance 'openmcl-inspector)) - (defimplementation describe-primitive-type (thing) (let ((typecode (ccl::typecode thing))) (if (gethash typecode *value2tag*) (string (gethash typecode *value2tag*)) (string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm)))))) -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o t)) (let* ((i (inspector::make-inspector o)) (count (inspector::compute-line-count i)) (lines @@ -814,7 +820,7 @@ (pprint o s))) lines))) -(defmethod inspect-for-emacs :around ((o t) (inspector backend-inspector)) +(defmethod inspect-for-emacs :around ((o t)) (if (or (uvector-inspector-p o) (not (ccl:uvectorp o))) (call-next-method) @@ -834,8 +840,7 @@ (:method ((object t)) nil) (:method ((object uvector-inspector)) t)) -(defmethod inspect-for-emacs ((uv uvector-inspector) - (inspector backend-inspector)) +(defmethod inspect-for-emacs ((uv uvector-inspector)) (with-slots (object) uv (values (format nil "The UVECTOR for ~S." object) @@ -855,8 +860,7 @@ (cellp (ccl::closed-over-value-p value))) (list label (if cellp (ccl::closed-over-value value) value)))))) -(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure) (inspector t)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((c ccl::compiled-lexical-closure)) (values (format nil "A closure: ~a" c) `(,@(if (arglist c) 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 Thu Feb 7 03:32:58 2008 @@ -1001,13 +1001,7 @@  ;;;; Inspector -(defclass sbcl-inspector (backend-inspector) ()) - -(defimplementation make-default-inspector () - (make-instance 'sbcl-inspector)) - -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o t)) (cond ((sb-di::indirect-value-cell-p o) (values "A value cell." (label-value-line* (:value (sb-kernel:value-cell-ref o))))) @@ -1019,8 +1013,7 @@ (values text (loop for value in parts for i from 0 append (label-value-line i value)))))))) -(defmethod inspect-for-emacs ((o function) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o function)) (let ((header (sb-kernel:widetag-of o))) (cond ((= header sb-vm:simple-fun-header-widetag) (values "A simple-fun." @@ -1041,8 +1034,7 @@ i (sb-kernel:%closure-index-ref o i)))))) (t (call-next-method o))))) -(defmethod inspect-for-emacs ((o sb-kernel:code-component) (_ backend-inspector)) - (declare (ignore _)) +(defmethod inspect-for-emacs ((o sb-kernel:code-component)) (values (format nil "~A is a code data-block." o) (append (label-value-line* @@ -1070,22 +1062,18 @@ (ash (sb-kernel:%code-code-size o) sb-vm:word-shift) :stream s)))))))) -(defmethod inspect-for-emacs ((o sb-ext:weak-pointer) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o sb-ext:weak-pointer)) (values "A weak pointer." (label-value-line* (:value (sb-ext:weak-pointer-value o))))) -(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o sb-kernel:fdefn)) (values "A fdefn object." (label-value-line* (:name (sb-kernel:fdefn-name o)) (:function (sb-kernel:fdefn-fun o))))) -(defmethod inspect-for-emacs :around ((o generic-function) - (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs :around ((o generic-function)) (multiple-value-bind (title contents) (call-next-method) (values title (append 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 Thu Feb 7 03:32:58 2008 @@ -1740,7 +1740,7 @@ :key #'symbol-value))) (format t ", type: ~A" type-symbol)))))) -(defmethod inspect-for-emacs ((o t) (inspector backend-inspector)) +(defmethod inspect-for-emacs ((o t)) (cond ((di::indirect-value-cell-p o) (values (format nil "~A is a value cell." o) `("Value: " (:value ,(c:value-cell-ref o))))) @@ -1759,8 +1759,7 @@ (loop for value in parts for i from 0 append (label-value-line i value)))))) -(defmethod inspect-for-emacs ((o function) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o function)) (let ((header (kernel:get-type o))) (cond ((= header vm:function-header-type) (values (format nil "~A is a function." o) @@ -1789,8 +1788,7 @@ (call-next-method))))) -(defmethod inspect-for-emacs ((o kernel:code-component) (_ backend-inspector)) - (declare (ignore _)) +(defmethod inspect-for-emacs ((o kernel:code-component)) (values (format nil "~A is a code data-block." o) (append (label-value-line* @@ -1817,8 +1815,7 @@ (ash (kernel:%code-code-size o) vm:word-shift) :stream s)))))))) -(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector backend-inspector)) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((o kernel:fdefn)) (values (format nil "~A is a fdenf object." o) (label-value-line* ("name" (kernel:fdefn-name o)) @@ -1827,8 +1824,7 @@ (sys:int-sap (kernel:get-lisp-obj-address o)) (* vm:fdefn-raw-addr-slot vm:word-bytes)))))) -(defmethod inspect-for-emacs ((o array) (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o array)) (cond ((kernel:array-header-p o) (values (format nil "~A is an array." o) (label-value-line* @@ -1847,8 +1843,7 @@ (:header (describe-primitive-type o)) (:length (length o))))))) -(defmethod inspect-for-emacs ((o simple-vector) (inspector backend-inspector)) - inspector +(defmethod inspect-for-emacs ((o simple-vector)) (values (format nil "~A is a vector." o) (append (label-value-line* Modified: branches/trunk-reorg/thirdparty/slime/swank.lisp ============================================================================== --- branches/trunk-reorg/thirdparty/slime/swank.lisp (original) +++ branches/trunk-reorg/thirdparty/slime/swank.lisp Thu Feb 7 03:32:58 2008 @@ -415,43 +415,6 @@ (<= (char-code c) 127))  -;;;;; Misc - -(defun length= (seq n) - "Test for whether SEQ contains N number of elements. I.e. it's equivalent - to (= (LENGTH SEQ) N), but besides being more concise, it may also be more - efficiently implemented." - (etypecase seq - (list (do ((i n (1- i)) - (list seq (cdr list))) - ((or (<= i 0) (null list)) - (and (zerop i) (null list))))) - (sequence (= (length seq) n)))) - -(defun ensure-list (thing) - (if (listp thing) thing (list thing))) - -(defun recursively-empty-p (list) - "Returns whether LIST consists only of arbitrarily nested empty lists." - (cond ((not (listp list)) nil) - ((null list) t) - (t (every #'recursively-empty-p list)))) - -(defun maybecall (bool fn &rest args) - "Call FN with ARGS if BOOL is T. Otherwise return ARGS as multiple values." - (if bool (apply fn args) (values-list args))) - -(defun exactly-one-p (&rest values) - "If exactly one value in VALUES is non-NIL, this value is returned. -Otherwise NIL is returned." - (let ((found nil)) - (dolist (v values) - (when v (if found - (return-from exactly-one-p nil) - (setq found v)))) - found)) - - ;;;;; Symbols (defun symbol-status (symbol &optional (package (symbol-package symbol))) @@ -1569,30 +1532,6 @@ (let ((*read-suppress* nil)) (read-from-string string)))) -(defun read-softly-from-string (string) - "Returns three values: - - 1. the object resulting from READing STRING. - - 2. The index of the first character in STRING that was not read. - - 3. T if the object is a symbol that had to be newly interned - in some package. (This does not work for symbols in - compound forms like lists or vectors.)" - (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string) - (if found? - (values symbol (length string) nil) - (multiple-value-bind (sexp pos) (read-from-string string) - (values sexp pos - (when (symbolp sexp) - (prog1 t - ;; assert that PARSE-SYMBOL didn't parse incorrectly. - (assert (and (equal symbol-name (symbol-name sexp)) - (eq package (symbol-package sexp))))))))))) - -(defun unintern-in-home-package (symbol) - (unintern symbol (symbol-package symbol))) - ;; FIXME: deal with #\| etc. hard to do portably. (defun tokenize-symbol (string) "STRING is interpreted as the string representation of a symbol @@ -1755,7 +1694,7 @@ (with-buffer-syntax () (let ((*print-readably* nil)) (cond ((null values) "; No value") - ((and (length= values 1) (integerp (car values))) + ((and (integerp (car values)) (null (cdr values))) (let ((i (car values))) (format nil "~A~D (#x~X, #o~O, #b~B)" *echo-area-prefix* i i i i))) @@ -2056,12 +1995,15 @@ ,(princ-to-string real-condition)))) (throw 'sldb-loop-catcher nil)) +(defvar *sldb-condition-printer* #'format-sldb-condition + "Function called to print a condition to an SLDB buffer.") + (defun safe-condition-message (condition) "Safely print condition to a string, handling any errors during printing." (let ((*print-pretty* t) (*print-right-margin* 65)) (handler-case - (format-sldb-condition condition) + (funcall *sldb-condition-printer* condition) (error (cond) ;; Beware of recursive errors in printing, so only use the condition ;; if it is printable itself: @@ -2750,8 +2692,7 @@ (set-pprint-dispatch '(cons (member function)) nil) (princ-to-string list))) -(defmethod inspect-for-emacs ((object cons) inspector) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((object cons)) (if (consp (cdr object)) (inspect-for-emacs-list object) (inspect-for-emacs-simple-cons object))) @@ -2811,8 +2752,7 @@ a hash table or array to show by default. If table has more than this then offer actions to view more. Set to nil for no limit." ) -(defmethod inspect-for-emacs ((ht hash-table) inspector) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((ht hash-table)) (values (prin1-to-string ht) (append (label-value-line* @@ -2864,8 +2804,7 @@ (progn (format t "How many elements should be shown? ") (read)))) (swank::inspect-object thing))))) -(defmethod inspect-for-emacs ((array array) inspector) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((array array)) (values "An array." (append (label-value-line* @@ -2883,8 +2822,7 @@ (loop for i below (or *slime-inspect-contents-limit* (array-total-size array)) append (label-value-line i (row-major-aref array i)))))) -(defmethod inspect-for-emacs ((char character) inspector) - (declare (ignore inspector)) +(defmethod inspect-for-emacs ((char character)) (values "A character." (append (label-value-line* @@ -2903,7 +2841,6 @@ (defvar *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)) (declaim (type vector *inspector-history*)) (defvar *inspect-length* 30) -(defvar *default-inspector* (make-default-inspector)) (defun reset-inspector () (setq *inspectee* nil @@ -2912,14 +2849,6 @@ *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0) *inspector-history* (make-array 10 :adjustable t :fill-pointer 0))) -(defun valid-function-name-p (form) - (or (symbolp form) - (and (consp form) - (second form) - (not (third form)) - (eq (first form) 'setf) - (symbolp (second form))))) - (defslimefun init-inspector (string) (with-buffer-syntax () (reset-inspector) @@ -2960,14 +2889,14 @@ (list :action label (assign-index (list lambda refreshp) *inspectee-actions*))) -(defun inspect-object (object &optional (inspector *default-inspector*)) +(defun inspect-object (object) (push (setq *inspectee* object) *inspector-stack*) (unless (find object *inspector-history*) (vector-push-extend object *inspector-history*)) (let ((*print-pretty* nil) ; print everything in the same line (*print-circle* t) (*print-readably* nil)) - (multiple-value-bind (_ content) (inspect-for-emacs object inspector) + (multiple-value-bind (_ content) (inspect-for-emacs object) (declare (ignore _)) (list :title (with-output-to-string (s) (print-unreadable-object (object s :type t :identity t)))