[slime-devel] PATCH: find-definitions patch for CLISP 2.46

[Masayuki Onjo]

Hi, Slime-developers.

The swank-backend::find-definitions function broken by CLISP's change.
(documentation symbol 'sys::file) returns following value:

OLD (2.41):
(path . lines)

NEW (2.46):
((type path . lines)
 (type path . lines)
 (type path . lines))

Patch makes swank-backend::find-definitions work with CLISP-2.46.

-- 
Masayuki Onjo
-------------- next part --------------
--- swank-clisp.lisp.orig	2008-08-04 02:35:43.000000000 +0900
+++ swank-clisp.lisp	2008-08-04 02:35:58.000000000 +0900
@@ -212,12 +212,14 @@
     (:function (describe (symbol-function symbol)))
     (:class (describe (find-class symbol)))))
 
-(defun fspec-pathname (symbol)
-  (let ((path (documentation symbol 'sys::file))
+(defun fspec-pathname (spec)
+  (let ((path spec)
+	type
         lines)
     (when (consp path)
-      (psetq path (car path)
-             lines (cdr path)))
+      (psetq type (car path)
+	     path (cadr path)
+             lines (cddr path)))
     (when (and path
                (member (pathname-type path)
                        custom:*compiled-file-types* :test #'equal))
@@ -225,24 +227,26 @@
             (loop for suffix in custom:*source-file-types*
                thereis (probe-file (make-pathname :defaults path
                                                   :type suffix)))))
-    (values path lines)))
+    (values path type lines)))
 
-(defun fspec-location (fspec)
-  (multiple-value-bind (file lines)
+(defun fspec-location (name fspec)
+  (multiple-value-bind (file type lines)
       (fspec-pathname fspec)
-    (cond (file
-           (multiple-value-bind (truename c) (ignore-errors (truename file))
-             (cond (truename
-                    (make-location (list :file (namestring truename))
-                                   (if (consp lines)
-                                       (list* :line lines)
-                                       (list :function-name (string fspec)))))
-                   (t (list :error (princ-to-string c))))))
-          (t (list :error (format nil "No source information available for: ~S"
-                                  fspec))))))
+    (list (if type (list name type) name)
+	  (cond (file
+		 (multiple-value-bind (truename c) (ignore-errors (truename file))
+		   (cond (truename
+			  (make-location (list :file (namestring truename))
+					 (if (consp lines)
+					     (list* :line lines)
+					     (list :function-name (string fspec)))
+					 (list :snippet (format nil "~A" type))))
+			 (t (list :error (princ-to-string c))))))
+		(t (list :error (format nil "No source information available for: ~S"
+					fspec)))))))
 
 (defimplementation find-definitions (name)
-  (list (list name (fspec-location name))))
+  (mapcar #'(lambda (e) (fspec-location name e)) (documentation name 'sys::file)))
 
 (defun trim-whitespace (string)
   (string-trim #(#\newline #\space #\tab) string))
@@ -573,9 +577,8 @@
           (load fasl-file))
         nil))))
 
-(defimplementation swank-compile-string (string &key buffer position directory
-                                                debug)
-  (declare (ignore directory debug))
+(defimplementation swank-compile-string (string &key buffer position directory)
+  (declare (ignore directory))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
           (*buffer-offset* position))
@@ -600,7 +603,7 @@
 (defun xref-results (symbols)
   (let ((xrefs '()))
     (dolist (symbol symbols)
-      (push (list symbol (fspec-location symbol)) xrefs))
+      (push (fspec-location symbol symbol) xrefs))
     xrefs))
 
 (when (find-package :swank-loader)