[slime-cvs] CVS update: slime/swank.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-cmucl.lisp slime/swank-backend.lisp slime/swank-allegro.lisp slime/ChangeLog
Marco Baringer
mbaringer at common-lisp.net
Mon Sep 13 16:42:36 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv7014
Modified Files:
swank.lisp swank-sbcl.lisp swank-openmcl.lisp swank-cmucl.lisp
swank-backend.lisp swank-allegro.lisp ChangeLog
Log Message:
2004-09-13 Marco Baringer <mb at bese.it>
* swank.lisp (inspected-parts): Added inspectors for pathnames,
logical pathnames, standard-objects and numbers (float, ratio,
integer and complex).
* swank-backend.lisp: Define import-to-swank-mop.
* swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp: Don't
define the import-to-swank-mop function (now defined in
swank-backend.lisp).
* swank-cmucl.lisp (swank-mop, function-name): Implement backend
for inspector.
(arglist): Add support for extracting arglists from function
objects.
(create-socket): Don't specify the host on PPC.
Date: Mon Sep 13 18:42:32 2004
Author: mbaringer
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.230 slime/swank.lisp:1.231
--- slime/swank.lisp:1.230 Mon Sep 13 02:14:47 2004
+++ slime/swank.lisp Mon Sep 13 18:42:31 2004
@@ -2451,16 +2451,14 @@
;;;; Inspecting
(defgeneric inspected-parts (object)
- (:documentation "
-Explan to emacs how to inspect OBJECT.
+ (:documentation "Explain to emacs how to inspect OBJECT.
-The first value must be a string, it will be used as the
-\"title\" of the inspector buffer.
+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.
-The second value must be a list, this list will be rendered by
-emacs in the inspector buffer. If the element of the list is a
-string it will be rendered as is, otherwise it must be a list
-like so:
+Every elementi of the list must be either a string, which will be
+inserted into the buffer as is, or a list of the form:
(:value object &optional format) - Render an inspectable
object. If format is provided it must be a string and will be
@@ -2474,6 +2472,7 @@
NIL - do nothing."))
(defmethod inspected-parts ((o t))
+ "Simply dump the output of CL:DESCRIBE."
(values (format nil "~S" o)
`("Don't know how to inspect the object, dumping output of CL:DESCIRBE:"
(:newline) (:newline)
@@ -2493,7 +2492,7 @@
(inspected-parts-of-simple-cons object)))
(defun inspected-parts-of-simple-cons (cons)
- (values (format nil "~S is a CONS." cons)
+ (values "A cons cell."
`("Car: " (:value ,(car cons))
(:newline)
"Cdr: " (:value ,(cdr cons)))))
@@ -2523,7 +2522,7 @@
,@(nreverse contents))))))
(defmethod inspected-parts ((ht hash-table))
- (values (format nil "The hash table ~S." ht)
+ (values "A hash table."
`("Count: " (:value ,(hash-table-count ht))
(:newline)
"Size: " (:value ,(hash-table-size ht))
@@ -2571,7 +2570,7 @@
collect '(:newline)))))
(defmethod inspected-parts ((char character))
- (values (format nil "~C is a character." char)
+ (values "A character."
`("Char code: " (:value ,(char-code char))
(:newline)
"Lower cased: " (:value ,(char-downcase char))
@@ -2594,7 +2593,7 @@
`("It names the package " (:value ,(find-package symbol)) (:newline))))
(class (when (find-class symbol nil)
`("It names the class " (:value ,(find-class symbol))))))
- (values (format nil "The symbol ~S." symbol)
+ (values "A symbol."
`("It's name is: " (:value ,(symbol-name symbol))
(:newline)
;; check to see whether it is a global variable, a
@@ -2628,19 +2627,44 @@
(princ (package-name (symbol-package symbol)) export-label)
(princ "]" export-label))
,(lambda () (export symbol (symbol-package symbol))))))
+ "Property list: " (:value ,(symbol-plist symbol))
(:newline)
, at package
, at class))))
(defmethod inspected-parts ((f function))
- (values (format nil "The function ~S." f)
+ (values "A function."
`("Name: " (:value ,(function-name f)) (:newline)
- "It's argument list is: " ,(princ-to-string (arglist f)) (:newline)
- "Documentation:" (:newline)
- ,(documentation f t))))
+ "It's argument list is: " ,(princ-to-string (arglist f))
+ (:newline)
+ ,@(when (documentation f t)
+ `("Documentation:" (:newline) ,(documentation f t) (:newline))))))
+
+(defmethod inspected-parts ((o standard-object))
+ (values "An object."
+ `("Class: " (:value ,(class-of o))
+ (:newline)
+ "Slots:" (:newline)
+ ,@(loop
+ with direct-slots = (swank-mop:class-direct-slots (class-of o))
+ for slot in (swank-mop:class-slots (class-of o))
+ for slot-def = (or (find-if (lambda (a)
+ ;; find the direct slot with the same as
+ ;; SLOT (an effective slot).
+ (eql (swank-mop:slot-definition-name a)
+ (swank-mop:slot-definition-name slot)))
+ direct-slots)
+ slot)
+ collect `(:value ,slot-def ,(princ-to-string (swank-mop:slot-definition-name slot-def)))
+ collect " = "
+ if (slot-boundp o (swank-mop:slot-definition-name slot-def))
+ collect `(:value ,(slot-value o (swank-mop:slot-definition-name slot-def)))
+ else
+ collect "#<unbound>"
+ collect '(:newline)))))
(defmethod inspected-parts ((gf standard-generic-function))
- (values (format nil "The generic function ~S." gf)
+ (values "A generic function."
`("Name: " (:value ,(swank-mop:generic-function-name gf)) (:newline)
"It's argument list is: " ,(princ-to-string (swank-mop:generic-function-lambda-list gf)) (:newline)
"Documentation: " (:newline)
@@ -2666,7 +2690,7 @@
collect '(:newline)))))
(defmethod inspected-parts ((method standard-method))
- (values (format nil "The method ~S." method)
+ (values "A method."
`("Method defined on the generic function " (:value ,(swank-mop:method-generic-function method)
,(princ-to-string
(swank-mop:generic-function-name
@@ -2675,12 +2699,13 @@
"Documentation:" (:newline) ,(documentation method t) (:newline)
"Lambda List: " (:value ,(swank-mop:method-lambda-list method))
(:newline)
- "Specializers: " (:value ,(swank-mop:method-specializers method))
+ "Specializers: " (:value ,(swank-mop:method-specializers method)
+ ,(princ-to-string (mapcar #'class-name (swank-mop:method-specializers method))))
(:newline)
"Qualifiers: " (:value ,(swank-mop:method-qualifiers method)))))
(defmethod inspected-parts ((class standard-class))
- (values (format nil "The class ~S." class)
+ (values "A class."
`("Name: " (:value ,(class-name class))
(:newline)
"Super classes: " ,@(common-seperated-spec (swank-mop:class-direct-superclasses class))
@@ -2715,7 +2740,7 @@
'"N/A (class not finalized)"))))
(defmethod inspected-parts ((slot swank-mop:standard-slot-definition))
- (values (format nil "The slot ~S." slot)
+ (values "A slot."
`("Name: " (:value ,(swank-mop:slot-definition-name slot))
(:newline)
"Documentation:" (:newline)
@@ -2742,7 +2767,7 @@
(push sym external-symbols)))))
(setf internal-symbols (sort internal-symbols #'string-lessp)
external-symbols (sort external-symbols #'string-lessp))
- (values (format nil "The package ~S." package)
+ (values "A package."
`("Name: " (:value ,(package-name package))
(:newline)
"Nick names: " ,@(common-seperated-spec (sort (package-nicknames package) #'string-lessp))
@@ -2770,6 +2795,88 @@
"0 shadowed symbols."
`(:value ,(package-shadowing-symbols package)
,(format nil "~D shadowed symbols." (length (package-shadowing-symbols package)))))))))
+
+(defmethod inspected-parts ((pathname pathname))
+ (values "A pathname."
+ `("Namestring: " (:value ,(namestring pathname))
+ (:newline)
+ "Host: " (:value ,(pathname-host pathname))
+ (:newline)
+ "Device: " (:value ,(pathname-device pathname))
+ (:newline)
+ "Directory: " (:value ,(pathname-directory pathname))
+ (:newline)
+ "Name: " (:value ,(pathname-name pathname))
+ (:newline)
+ "Type: " (:value ,(pathname-type pathname))
+ (:newline)
+ "Version: " (:value ,(pathname-version pathname))
+ (:newline)
+ "Truename: " (:value ,(truename pathname)))))
+
+(defmethod inspected-parts ((pathname logical-pathname))
+ (values "A logical pathname."
+ `("Namestring: " (:value ,(namestring pathname))
+ (:newline)
+ "Physical pathname: " (:value ,(translate-logical-pathname pathname))
+ (:newline)
+ "Host: " (:value ,(pathname-host pathname))
+ " (" (:value ,(logical-pathname-translations (pathname-host pathname)) "other translations") ")"
+ (:newline)
+ "Directory: " (:value ,(pathname-directory pathname))
+ (:newline)
+ "Name: " (:value ,(pathname-name pathname))
+ (:newline)
+ "Type: " (:value ,(pathname-type pathname))
+ (:newline)
+ "Version: " (:value ,(pathname-version pathname)))))
+
+(defmethod inspected-parts ((n number))
+ (values "A number." `("Value: " ,(princ-to-string n))))
+
+(defmethod inspected-parts ((i integer))
+ (values "A number."
+ `("Value: " ,(princ-to-string i)
+ " == #x" ,(format nil "~X" i)
+ " == #o" ,(format nil "~O" i)
+ " == #b" ,(format nil "~B" i)
+ " == " ,(format nil "~E" i)
+ (:newline)
+ ,@(when (< -1 i char-code-limit)
+ `("Corresponding character: " (:value ,(code-char i)) (:newline)))
+ "Length: " (:value ,(integer-length i))
+ (:newline)
+ "As time: " , (multiple-value-bind (sec min hour date month year daylight-p zone)
+ (decode-universal-time i)
+ (declare (ignore daylight-p zone))
+ (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ"
+ year month date hour min sec)))))
+
+(defmethod inspected-parts ((c complex))
+ (values "A complex number."
+ `("Real part: " (:value ,(realpart c))
+ (:newline)
+ "Imaginary part: " (:value ,(imagpart c)))))
+
+(defmethod inspected-parts ((r ratio))
+ (values "A non-integer ratio."
+ `("Numerator: " (:value ,(numerator r))
+ (:newline)
+ "Denominator: " (:value ,(denominator r))
+ (:newline)
+ "As float: " (:value ,(float r)))))
+
+(defmethod inspected-parts ((f float))
+ (multiple-value-bind (significand exponent sign)
+ (decode-float f)
+ (values "A floating point number."
+ `("Scientific: " ,(format nil "~E" f)
+ (:newline)
+ "Decoded: " (:value ,sign) " * " (:value ,significand) " * " (:value ,(float-radix f)) "^" (:value ,exponent)
+ (:newline)
+ "Digits: " (:value ,(float-digits f))
+ (:newline)
+ "Precision: " (:value ,(float-precision f))))))
;;;; Inspecting
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.100 slime/swank-sbcl.lisp:1.101
--- slime/swank-sbcl.lisp:1.100 Mon Sep 13 01:56:39 2004
+++ slime/swank-sbcl.lisp Mon Sep 13 18:42:31 2004
@@ -37,65 +37,49 @@
;;; swank-mop
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ sb-mop::standard-slot-definition
+ cl:method
+ cl:standard-class
+ ;; standard-class readers
+ sb-mop:class-default-initargs
+ sb-mop:class-direct-default-initargs
+ sb-mop:class-direct-slots
+ sb-mop:class-direct-subclasses
+ sb-mop:class-direct-superclasses
+ sb-mop:class-finalized-p
+ cl:class-name
+ sb-mop:class-precedence-list
+ sb-mop:class-prototype
+ sb-mop:class-slots
+ ;; generic function readers
+ sb-mop:generic-function-argument-precedence-order
+ sb-mop:generic-function-declarations
+ sb-mop:generic-function-lambda-list
+ sb-mop:generic-function-methods
+ sb-mop:generic-function-method-class
+ sb-mop:generic-function-method-combination
+ sb-mop:generic-function-name
+ ;; method readers
+ sb-mop:method-generic-function
+ sb-mop:method-function
+ sb-mop:method-lambda-list
+ sb-mop:method-specializers
+ sb-mop:method-qualifiers
+ ;; slot readers
+ sb-mop:slot-definition-allocation
+ sb-mop:slot-definition-initargs
+ sb-mop:slot-definition-initform
+ sb-mop:slot-definition-initfunction
+ sb-mop:slot-definition-name
+ sb-mop:slot-definition-type
+ sb-mop:slot-definition-readers
+ sb-mop:slot-definition-writers))
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun import-to-swank-mop (sym/sym-list)
- (if (listp sym/sym-list)
- (dolist (sym sym/sym-list)
- (import-to-swank-mop sym))
- (let* ((sym sym/sym-list)
- (swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
- ;; 1) "delete" the symbol form the :swank-mop package
- (when swank-mop-sym
- (unintern swank-mop-sym :swank-mop))
- (import sym :swank-mop)
- (export sym :swank-mop))))
-
- (import-to-swank-mop
- '( ;; classes
- cl:standard-generic-function
- sb-mop::standard-slot-definition
- cl:method
- cl:standard-class
- ;; standard-class readers
- sb-mop:class-default-initargs
- sb-mop:class-direct-default-initargs
- sb-mop:class-direct-slots
- sb-mop:class-direct-subclasses
- sb-mop:class-direct-superclasses
- sb-mop:class-finalized-p
- cl:class-name
- sb-mop:class-precedence-list
- sb-mop:class-prototype
- sb-mop:class-slots
- ;; generic function readers
- sb-mop:generic-function-argument-precedence-order
- sb-mop:generic-function-declarations
- sb-mop:generic-function-lambda-list
- sb-mop:generic-function-methods
- sb-mop:generic-function-method-class
- sb-mop:generic-function-method-combination
- sb-mop:generic-function-name
- ;; method readers
- sb-mop:method-generic-function
- sb-mop:method-function
- sb-mop:method-lambda-list
- sb-mop:method-specializers
- sb-mop:method-qualifiers
- ;; slot readers
- sb-mop:slot-definition-allocation
- sb-mop:slot-definition-initargs
- sb-mop:slot-definition-initform
- sb-mop:slot-definition-initfunction
- sb-mop:slot-definition-name
- sb-mop:slot-definition-type
- sb-mop:slot-definition-readers
- sb-mop:slot-definition-writers))
-
- (defun swank-mop:slot-definition-documentation (slot)
- (sb-pcl::documentation slot t))
-
- )
+(defun swank-mop:slot-definition-documentation (slot)
+ (sb-pcl::documentation slot t))
;;; TCP Server
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.81 slime/swank-openmcl.lisp:1.82
--- slime/swank-openmcl.lisp:1.81 Mon Sep 13 07:39:06 2004
+++ slime/swank-openmcl.lisp Mon Sep 13 18:42:31 2004
@@ -69,60 +69,47 @@
;;; swank-mop
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun import-to-swank-mop (sym/sym-list)
- (if (listp sym/sym-list)
- (dolist (sym sym/sym-list)
- (import-to-swank-mop sym))
- (let* ((sym sym/sym-list)
- (swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
- ;; 1) "delete" the symbol form the :swank-mop package
- (when swank-mop-sym
- (unintern swank-mop-sym :swank-mop))
- (import sym :swank-mop)
- (export sym :swank-mop))))
-
- (import-to-swank-mop
- '( ;; classes
- cl:standard-generic-function
- ccl::standard-slot-definition
- cl:method
- cl:standard-class
- ;; standard-class readers
- openmcl-mop:class-default-initargs
- openmcl-mop:class-direct-default-initargs
- openmcl-mop:class-direct-slots
- openmcl-mop:class-direct-subclasses
- openmcl-mop:class-direct-superclasses
- openmcl-mop:class-finalized-p
- cl:class-name
- openmcl-mop:class-precedence-list
- openmcl-mop:class-prototype
- openmcl-mop:class-slots
- ;; generic function readers
- openmcl-mop:generic-function-argument-precedence-order
- openmcl-mop:generic-function-declarations
- openmcl-mop:generic-function-lambda-list
- openmcl-mop:generic-function-methods
- openmcl-mop:generic-function-method-class
- openmcl-mop:generic-function-method-combination
- openmcl-mop:generic-function-name
- ;; method readers
- openmcl-mop:method-generic-function
- openmcl-mop:method-function
- openmcl-mop:method-lambda-list
- openmcl-mop:method-specializers
- openmcl-mop:method-qualifiers
- ;; slot readers
- openmcl-mop:slot-definition-allocation
- ccl::slot-definition-documentation
- openmcl-mop:slot-definition-initargs
- openmcl-mop:slot-definition-initform
- openmcl-mop:slot-definition-initfunction
- openmcl-mop:slot-definition-name
- openmcl-mop:slot-definition-type
- openmcl-mop:slot-definition-readers
- openmcl-mop:slot-definition-writers)))
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ ccl::standard-slot-definition
+ cl:method
+ cl:standard-class
+ ;; standard-class readers
+ openmcl-mop:class-default-initargs
+ openmcl-mop:class-direct-default-initargs
+ openmcl-mop:class-direct-slots
+ openmcl-mop:class-direct-subclasses
+ openmcl-mop:class-direct-superclasses
+ openmcl-mop:class-finalized-p
+ cl:class-name
+ openmcl-mop:class-precedence-list
+ openmcl-mop:class-prototype
+ openmcl-mop:class-slots
+ ;; generic function readers
+ openmcl-mop:generic-function-argument-precedence-order
+ openmcl-mop:generic-function-declarations
+ openmcl-mop:generic-function-lambda-list
+ openmcl-mop:generic-function-methods
+ openmcl-mop:generic-function-method-class
+ openmcl-mop:generic-function-method-combination
+ openmcl-mop:generic-function-name
+ ;; method readers
+ openmcl-mop:method-generic-function
+ openmcl-mop:method-function
+ openmcl-mop:method-lambda-list
+ openmcl-mop:method-specializers
+ openmcl-mop:method-qualifiers
+ ;; slot readers
+ openmcl-mop:slot-definition-allocation
+ ccl::slot-definition-documentation
+ openmcl-mop:slot-definition-initargs
+ openmcl-mop:slot-definition-initform
+ openmcl-mop:slot-definition-initfunction
+ openmcl-mop:slot-definition-name
+ openmcl-mop:slot-definition-type
+ openmcl-mop:slot-definition-readers
+ openmcl-mop:slot-definition-writers))
;;; TCP Server
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.114 slime/swank-cmucl.lisp:1.115
--- slime/swank-cmucl.lisp:1.114 Fri Sep 3 23:08:51 2004
+++ slime/swank-cmucl.lisp Mon Sep 13 18:42:31 2004
@@ -17,6 +17,50 @@
;;; promptly delete them from here. It is enough to be compatible with
;;; the latest release.
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ pcl:standard-slot-definition
+ cl:method
+ cl:standard-class
+ ;; standard-class readers
+ pcl:class-default-initargs
+ pcl:class-direct-default-initargs
+ pcl:class-direct-slots
+ pcl:class-direct-subclasses
+ pcl:class-direct-superclasses
+ pcl:class-finalized-p
+ cl:class-name
+ pcl:class-precedence-list
+ pcl:class-prototype
+ pcl:class-slots
+ ;; generic function readers
+ pcl:generic-function-argument-precedence-order
+ pcl:generic-function-declarations
+ pcl:generic-function-lambda-list
+ pcl:generic-function-methods
+ pcl:generic-function-method-class
+ pcl:generic-function-method-combination
+ pcl:generic-function-name
+ ;; method readers
+ pcl:method-generic-function
+ pcl:method-function
+ pcl:method-lambda-list
+ pcl:method-specializers
+ pcl:method-qualifiers
+ ;; slot readers
+ pcl:slot-definition-allocation
+ pcl:slot-definition-initargs
+ pcl:slot-definition-initform
+ pcl:slot-definition-initfunction
+ pcl:slot-definition-name
+ pcl:slot-definition-type
+ pcl:slot-definition-readers
+ pcl:slot-definition-writers))
+
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot t))
+
(in-package :lisp)
;;; `READ-SEQUENCE' with large sequences has problems in 18e. This new
@@ -72,9 +116,10 @@
:sigio)
(defimplementation create-socket (host port)
+ #+ppc (declare (ignore host))
(ext:create-inet-listener port :stream
:reuse-address t
- :host (resolve-hostname host)))
+ #-ppc :host #-ppc (resolve-hostname host)))
(defimplementation local-port (socket)
(nth-value 1 (ext::get-socket-host-and-port (socket-fd socket))))
@@ -1282,27 +1327,39 @@
;;;;; Argument lists
-(defimplementation arglist (symbol)
- (let* ((fun (or (macro-function symbol)
- (symbol-function symbol)))
- (arglist
- (cond ((eval:interpreted-function-p fun)
- (eval:interpreted-function-arglist fun))
- ((pcl::generic-function-p fun)
- (pcl:generic-function-lambda-list fun))
- ((c::byte-function-or-closure-p fun)
- (byte-code-function-arglist fun))
- ((kernel:%function-arglist (kernel:%function-self fun))
- (handler-case (read-arglist fun)
- (error () :not-available)))
- ;; this should work both for compiled-debug-function
- ;; and for interpreted-debug-function
- (t
- (handler-case (debug-function-arglist
- (di::function-debug-function fun))
- (di:unhandled-condition () :not-available))))))
+(defimplementation arglist ((name symbol))
+ (arglist (or (macro-function name)
+ (symbol-function name)
+ (error "~S does not name a known function."))))
+
+(defimplementation arglist ((fun function))
+ (let ((arglist
+ (cond ((eval:interpreted-function-p fun)
+ (eval:interpreted-function-arglist fun))
+ ((pcl::generic-function-p fun)
+ (pcl:generic-function-lambda-list fun))
+ ((c::byte-function-or-closure-p fun)
+ (byte-code-function-arglist fun))
+ ((kernel:%function-arglist (kernel:%function-self fun))
+ (handler-case (read-arglist fun)
+ (error () :not-available)))
+ ;; this should work both for compiled-debug-function
+ ;; and for interpreted-debug-function
+ (t
+ (handler-case (debug-function-arglist
+ (di::function-debug-function fun))
+ (di:unhandled-condition () :not-available))))))
(check-type arglist (or list (member :not-available)))
arglist))
+
+(defimplementation function-name (function)
+ (cond ((eval:interpreted-function-p function)
+ (eval:interpreted-function-name function))
+ ((pcl::generic-function-p function)
+ (pcl::generic-function-name function))
+ ((c::byte-function-or-closure-p function)
+ (c::byte-function-name function))
+ (t (kernel:%function-name (kernel:%function-self function)))))
;;; A simple case: the arglist is available as a string that we can
;;; `read'.
Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.65 slime/swank-backend.lisp:1.66
--- slime/swank-backend.lisp:1.65 Mon Sep 13 01:56:39 2004
+++ slime/swank-backend.lisp Mon Sep 13 18:42:31 2004
@@ -72,6 +72,14 @@
#:slot-definition-readers
#:slot-definition-writers))
+(defun swank-backend::import-to-swank-mop (symbol-list)
+ (dolist (sym symbol-list)
+ (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
+ (when swank-mop-sym
+ (unintern swank-mop-sym :swank-mop))
+ (import sym :swank-mop)
+ (export sym :swank-mop))))
+
(in-package :swank-backend)
Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.53 slime/swank-allegro.lisp:1.54
--- slime/swank-allegro.lisp:1.53 Mon Sep 13 01:56:39 2004
+++ slime/swank-allegro.lisp Mon Sep 13 18:42:31 2004
@@ -29,68 +29,50 @@
;;; swank-mop
-(eval-when (:compile-toplevel :load-toplevel :execute)
- ;; Copied from swank-sbcl.lisp
- ;; not sure if we still want a list of lists
- ;; also not sure if we need to re-import too
- (defun import-to-swank-mop (sym/sym-list)
- (if (listp sym/sym-list)
- (dolist (sym sym/sym-list)
- (import-to-swank-mop sym))
- (let* ((sym sym/sym-list)
- (swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
- ;; 1) "delete" the symbol form the :swank-mop package
- (when swank-mop-sym
- (unintern swank-mop-sym :swank-mop))
- (import sym :swank-mop)
- (export sym :swank-mop))))
-
- ;; maybe better change MOP to ACLMOP ?
- (import-to-swank-mop
- '( ;; classes
- cl:standard-generic-function
- mop::standard-slot-definition
- cl:method
- cl:standard-class
- ;; standard-class readers
- mop:class-default-initargs
- mop:class-direct-default-initargs
- mop:class-direct-slots
- mop:class-direct-subclasses
- mop:class-direct-superclasses
- mop:class-finalized-p
- cl:class-name
- mop:class-precedence-list
- mop:class-prototype
- mop:class-slots
- ;; generic function readers
- mop:generic-function-argument-precedence-order
- mop:generic-function-declarations
- mop:generic-function-lambda-list
- mop:generic-function-methods
- mop:generic-function-method-class
- mop:generic-function-method-combination
- mop:generic-function-name
- ;; method readers
- mop:method-generic-function
- mop:method-function
- mop:method-lambda-list
- mop:method-specializers
- excl::method-qualifiers
- ;; slot readers
- mop:slot-definition-allocation
- mop:slot-definition-initargs
- mop:slot-definition-initform
- mop:slot-definition-initfunction
- mop:slot-definition-name
- mop:slot-definition-type
- mop:slot-definition-readers
- mop:slot-definition-writers))
-
- (defun swank-mop:slot-definition-documentation (slot)
- (documentation slot))
- )
+;; maybe better change MOP to ACLMOP ?
+(import-to-swank-mop
+ '( ;; classes
+ cl:standard-generic-function
+ mop::standard-slot-definition
+ cl:method
+ cl:standard-class
+ ;; standard-class readers
+ mop:class-default-initargs
+ mop:class-direct-default-initargs
+ mop:class-direct-slots
+ mop:class-direct-subclasses
+ mop:class-direct-superclasses
+ mop:class-finalized-p
+ cl:class-name
+ mop:class-precedence-list
+ mop:class-prototype
+ mop:class-slots
+ ;; generic function readers
+ mop:generic-function-argument-precedence-order
+ mop:generic-function-declarations
+ mop:generic-function-lambda-list
+ mop:generic-function-methods
+ mop:generic-function-method-class
+ mop:generic-function-method-combination
+ mop:generic-function-name
+ ;; method readers
+ mop:method-generic-function
+ mop:method-function
+ mop:method-lambda-list
+ mop:method-specializers
+ excl::method-qualifiers
+ ;; slot readers
+ mop:slot-definition-allocation
+ mop:slot-definition-initargs
+ mop:slot-definition-initform
+ mop:slot-definition-initfunction
+ mop:slot-definition-name
+ mop:slot-definition-type
+ mop:slot-definition-readers
+ mop:slot-definition-writers))
+(defun swank-mop:slot-definition-documentation (slot)
+ (documentation slot))
;;;; TCP Server
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.521 slime/ChangeLog:1.522
--- slime/ChangeLog:1.521 Mon Sep 13 10:47:14 2004
+++ slime/ChangeLog Mon Sep 13 18:42:31 2004
@@ -1,3 +1,21 @@
+2004-09-13 Marco Baringer <mb at bese.it>
+
+ * swank.lisp (inspected-parts): Added inspectors for pathnames,
+ logical pathnames, standard-objects and numbers (float, ratio,
+ integer and complex).
+
+ * swank-backend.lisp: Define import-to-swank-mop.
+
+ * swank-openmcl.lisp, swank-sbcl.lisp, swank-allegro.lisp: Don't
+ define the import-to-swank-mop function (now defined in
+ swank-backend.lisp).
+
+ * swank-cmucl.lisp (swank-mop, function-name): Implement backend
+ for inspector.
+ (arglist): Add support for extracting arglists from function
+ objects.
+ (create-socket): Don't specify the host on PPC.
+
2004-09-13 Alan Ruttenberg <alanr-l at mumble.net>
* slime.el slime-goto-location-position: New location specifiers:
More information about the slime-cvs
mailing list