[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv13391

Modified Files:
	ChangeLog swank-clisp.lisp 
Log Message:
Updates for CLISP-2.46.
Patch by Masayuki Onjo.

* swank-clisp.lisp (fspec-pathname, fspec-location): The structure
of (documentation symbol 'sys::file) used to be (path . lines)
but is now ((type path . lines) ...).

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/04 20:25:42	1.1388
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/04 20:25:49	1.1389
@@ -1,5 +1,15 @@
+2008-08-04  Masayuki Onjo <masayuki.onjo at gmail.com>
+
+	Updates for CLISP-2.46.
+
+	* swank-clisp.lisp (fspec-pathname, fspec-location): The structure
+	of (documentation symbol 'sys::file) used to be (path . lines)
+	but is now ((type path . lines) ...).
+
 2008-08-04  Helmut Eller  <heller at common-lisp.net>
 
+
+
 	* swank-gray.lisp (slime-output-stream): Add a slot
 	"interactive-p" which should be true for streams which are flushed
 	periodically by the Lisp system.  Update the relevant backends
--- /project/slime/cvsroot/slime/swank-clisp.lisp	2008/08/03 18:23:10	1.70
+++ /project/slime/cvsroot/slime/swank-clisp.lisp	2008/08/04 20:25:50	1.71
@@ -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)