[slime-cvs] CVS update: slime/swank.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv4868

Modified Files:
	swank.lisp 
Log Message:
(mop, mop-helper): Support functions for the class browser.  By Rui
Patrocínio.


Date: Tue Sep 28 00:23:01 2004
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.243 slime/swank.lisp:1.244
--- slime/swank.lisp:1.243	Fri Sep 24 00:23:07 2004
+++ slime/swank.lisp	Tue Sep 28 00:23:01 2004
@@ -2947,7 +2947,7 @@
            (if (< -1 i char-code-limit)
                (label-value-line "Corresponding character" (code-char i)))
            (label-value-line "Length" (integer-length i))
-           (list "As time" 
+           (list "As time: " 
                  (multiple-value-bind (sec min hour date month year)
                      (decode-universal-time i)
                    (format nil "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0DZ"
@@ -2958,15 +2958,15 @@
   (values "A complex number."
           (label-value-line* 
            ("Real part" (realpart c))
-           ("Imaginary part" (imagpart c))))) 
+           ("Imaginary part" (imagpart c)))))
 
 (defmethod inspect-for-emacs ((r ratio) (inspector t))
   (declare (ignore inspector))
   (values "A non-integer ratio."
           (label-value-line*
-           ("Numerator" (numerator r)
+           ("Numerator" (numerator r))
            ("Denominator" (denominator r))
-           ("As float" (float r))))))
+           ("As float" (float r)))))
 
 (defmethod inspect-for-emacs ((f float) (inspector t))
   (declare (ignore inspector))
@@ -2981,9 +2981,6 @@
              (label-value-line "Digits" (float-digits f))
              (label-value-line "Precision" (float-precision f))))))
 
-
-;;;; Inspecting
-
 (defvar *inspectee*)
 (defvar *inspectee-parts* (make-array 10 :adjustable t :fill-pointer 0))
 (defvar *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0))
@@ -3138,6 +3135,29 @@
   (interrupt-thread (nth-thread index)
                     (lambda () 
                       (start-server port-file-name nil))))
+
+;;;; Class browser
+
+(defun mop-helper (class-name fn)
+  (let ((class (find-class class-name nil)))
+    (if class
+        (mapcar (lambda (x) (to-string (class-name x)))
+                (funcall fn class)))))
+
+(defslimefun mop (type symbol-name)
+  "Return info about classes using mop.
+
+    When type is:
+     :subclasses - return the list of subclasses of class.
+     :superclasses - return the list of superclasses of class."
+  (let ((symbol (parse-symbol symbol-name *buffer-package*)))
+    (ecase type
+      (:subclasses
+       (mop-helper symbol #'swank-mop:class-direct-subclasses))
+      (:superclasses 
+       (mop-helper symbol #'swank-mop:class-direct-superclasses)))))
+
+
 
 
 ;;;; Automatically synchronized state