[slime-cvs] CVS update: slime/slime.el slime/swank-lispworks.lisp slime/swank-cmucl.lisp slime/swank-sbcl.lisp

[Helmut Eller]

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

Modified Files:
	slime.el swank-lispworks.lisp swank-cmucl.lisp swank-sbcl.lisp 
Log Message:
more tweaking.

Date: Wed Mar 10 04:10:34 2004
Author: heller

Index: slime/slime.el
diff -u slime/slime.el:1.232 slime/slime.el:1.233
--- slime/slime.el:1.232	Wed Mar 10 03:21:04 2004
+++ slime/slime.el	Wed Mar 10 04:10:33 2004
@@ -3499,7 +3499,7 @@
 (defun slime-show-definitions (name definitions)
   (slime-show-xrefs 
    `((,name . ,(loop for (dspec location) in definitions
-                     collect (cons (format "%s" dspec) location))))
+                     collect (cons dspec location))))
    'definition
    name
    (slime-buffer-package)))


Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.33 slime/swank-lispworks.lisp:1.34
--- slime/swank-lispworks.lisp:1.33	Wed Mar 10 03:24:45 2004
+++ slime/swank-lispworks.lisp	Wed Mar 10 04:10:33 2004
@@ -278,8 +278,15 @@
              (delete-file binary-filename))))
     (delete-file filename)))
 
-(defun dspec-buffer-position (dspec)
-  (list :function-name (string (dspec:dspec-primary-name dspec))))
+(defun dspec-buffer-position (dspec offset)
+  (etypecase dspec
+    (cons (let ((name (dspec:dspec-primary-name dspec)))
+            (etypecase name
+              ((or symbol string) 
+               (list :function-name (string name)))
+              (t (list :position offset)))))
+    (null (list :position offset))
+    (symbol (list :function-name (string dspec)))))
 
 (defun emacs-buffer-location-p (location)
   (and (consp location)
@@ -300,13 +307,13 @@
     (etypecase location
       ((or pathname string) 
        (make-location `(:file ,(filename location))
-                      (dspec-buffer-position dspec)))
+                      (dspec-buffer-position dspec 1)))
       (symbol `(:error ,(format nil "Cannot resolve location: ~S" location)))
       ((satisfies emacs-buffer-location-p)
        (destructuring-bind (_ buffer offset string) location
-         (declare (ignore _ offset string))
+         (declare (ignore _ string))
          (make-location `(:buffer ,buffer)
-                        (dspec-buffer-position dspec)))))))
+                        (dspec-buffer-position dspec offset)))))))
 
 (defun signal-error-data-base (database location)
   (map-error-database 


Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.83 slime/swank-cmucl.lisp:1.84
--- slime/swank-cmucl.lisp:1.83	Wed Mar 10 03:24:44 2004
+++ slime/swank-cmucl.lisp	Wed Mar 10 04:10:33 2004
@@ -674,7 +674,7 @@
   "Return definitions in the \"function namespace\", i.e.,
 regular functions, generic functions, methods and macros."
   (cond ((macro-function symbol)
-         (list `((macro ,symbol)
+         (list `((defmacro ,symbol)
                  ,(function-location (macro-function symbol)))))
         ((special-operator-p symbol)
          (list `((:special-operator ,symbol) 
@@ -683,7 +683,7 @@
         ((fboundp symbol)
          (let ((function (coerce symbol 'function)))
            (cond ((genericp function)
-                  (cons (list `(:generic-function ,symbol)
+                  (cons (list `(defgeneric ,symbol)
                               (function-location function))
                         (gf-method-definitions function)))
                  (t (list (list `(function ,symbol)


Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.75 slime/swank-sbcl.lisp:1.76
--- slime/swank-sbcl.lisp:1.75	Wed Mar 10 03:24:45 2004
+++ slime/swank-sbcl.lisp	Wed Mar 10 04:10:34 2004
@@ -381,14 +381,15 @@
 (defun function-definitions (symbol)
   (flet ((loc (fun name) (safe-function-source-location fun name)))
     (cond ((macro-function symbol)
-           (list (list `(macro ,symbol) (loc (macro-function symbol) symbol))))
+           (list (list `(defmacro ,symbol) 
+                       (loc (macro-function symbol) symbol))))
           ((fboundp symbol)
            (let ((fun (symbol-function symbol)))
              (cond ((typep fun 'sb-mop:generic-function)
-                    (cons (list `(function ,symbol) (loc fun symbol))
+                    (cons (list `(defgeneric ,symbol) (loc fun symbol))
                           (method-definitions fun)))
                    (t
-                    (list (list symbol (loc fun symbol))))))))))
+                    (list (list `(function ,symbol) (loc fun symbol))))))))))
 
 (defimplementation find-definitions (symbol)
   (function-definitions symbol))