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

-- Masayuki Onjo --- 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)