[slime-cvs] CVS update: slime/ChangeLog slime/swank-sbcl.lisp
Juho Snellman
jsnellman at common-lisp.net
Sun Nov 6 09:09:50 UTC 2005
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv2339
Modified Files:
ChangeLog swank-sbcl.lisp
Log Message:
swank-sbcl.lisp (find-definitions, make-source-location-specification
make-definition-source-location, source-hint-snippet):
As of SBCL 0.9.6.25 SB-INTROSPECT has better support for finding
source locations. Use as much of it in swank-sbcl as possible.
(Original version left reader-conditionalized for older SBCLs).
Date: Sun Nov 6 10:09:48 2005
Author: jsnellman
Index: slime/ChangeLog
diff -u slime/ChangeLog:1.805 slime/ChangeLog:1.806
--- slime/ChangeLog:1.805 Fri Nov 4 10:07:43 2005
+++ slime/ChangeLog Sun Nov 6 10:09:47 2005
@@ -1,3 +1,11 @@
+2005-11-06 Juho Snellman <jsnell at iki.fi>
+
+ * swank-sbcl.lisp (find-definitions, make-source-location-specification
+ make-definition-source-location, source-hint-snippet): As of
+ SBCL 0.9.6.25 SB-INTROSPECT has better support for finding
+ source locations. Use as much of it in swank-sbcl as possible.
+ (Original version left reader-conditionalized for older SBCLs).
+
2005-11-04 Helmut Eller <heller at common-lisp.net>
* swank.lisp (connection-info): Docfix.
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.148 slime/swank-sbcl.lisp:1.149
--- slime/swank-sbcl.lisp:1.148 Sun Oct 23 10:47:54 2005
+++ slime/swank-sbcl.lisp Sun Nov 6 10:09:48 2005
@@ -395,6 +395,108 @@
"When true don't handle errors while looking for definitions.
This is useful when debugging the definition-finding code.")
+;;; As of SBCL 0.9.7 most of the gritty details of source location handling
+;;; are supported reasonably well by SB-INTROSPECT.
+
+;;; SBCL > 0.9.6
+#+#.(cl:if (cl:find-symbol "FIND-DEFINITION-SOURCES-BY-NAME" "SB-INTROSPECT")
+ '(and)
+ '(or))
+(progn
+
+(defparameter *definition-types*
+ '(:variable defvar
+ :constant defconstant
+ :type deftype
+ :symbol-macro define-symbol-macro
+ :macro defmacro
+ :compiler-macro define-compiler-macro
+ :function defun
+ :generic-function defgeneric
+ :method defmethod
+ :setf-expander define-setf-expander
+ :structure defstruct
+ :condition defcondition
+ :class defclass
+ :method-combination define-method-combination
+ :package defpackage
+ :transform :deftransform
+ :optimizer :defoptimizer
+ :vop :define-vop
+ :source-transform :define-source-transform)
+ "Map SB-INTROSPECT definition type names to Slime-friendly forms")
+
+(defimplementation find-definitions (name)
+ (loop for type in *definition-types* by #'cddr
+ for locations = (sb-introspect:find-definition-sources-by-name
+ name type)
+ append (loop for source-location in locations collect
+ (make-source-location-specification type name
+ source-location))))
+
+(defun make-source-location-specification (type name source-location)
+ (list (list* (getf *definition-types* type)
+ name
+ (sb-introspect::definition-source-description source-location))
+ (if *debug-definition-finding*
+ (make-definition-source-location source-location type name)
+ (handler-case (make-definition-source-location source-location
+ type name)
+ (error (e)
+ (list :error (format nil "Error: ~A" e)))))))
+
+(defun make-definition-source-location (definition-source type name)
+ (with-struct (sb-introspect::definition-source-
+ pathname form-path character-offset plist
+ file-write-date)
+ definition-source
+ (destructuring-bind (&key emacs-buffer emacs-position
+ emacs-string &allow-other-keys)
+ plist
+ (cond
+ (emacs-buffer
+ (let ((pos (if form-path
+ (with-debootstrapping
+ (source-path-string-position
+ form-path emacs-string))
+ character-offset)))
+ (make-location `(:buffer ,emacs-buffer)
+ `(:position ,(+ pos emacs-position))
+ `(:snippet ,emacs-string))))
+ ((not pathname)
+ `(:error ,(format nil "Source of ~A ~A not found"
+ (string-downcase type) name)))
+ (t
+ (let* ((namestring (namestring (translate-logical-pathname pathname)))
+ (*readtable* (guess-readtable-for-filename namestring))
+ (pos (1+ (with-debootstrapping
+ ;; Some internal functions have no source path
+ ;; or offset available, just the file (why?).
+ ;; In these cases we can at least try to open
+ ;; the right file.
+ (if form-path
+ (source-path-file-position form-path
+ pathname)
+ 0))))
+ (snippet (source-hint-snippet namestring
+ file-write-date pos)))
+ (make-location `(:file ,namestring)
+ `(:position ,pos)
+ `(:snippet ,snippet))))))))
+
+(defun source-hint-snippet (filename write-date position)
+ (let ((source (get-source-code filename write-date)))
+ (with-input-from-string (s source)
+ (read-snippet s position))))
+
+) ;; End >0.9.6
+
+;;; Support for SBCL 0.9.6 and earlier. Feel free to delete this
+;;; after January 2006.
+#-#.(cl:if (cl:find-symbol "FIND-DEFINITION-SOURCES-BY-NAME" "SB-INTROSPECT")
+ '(and)
+ '(or))
+(progn
(defimplementation find-definitions (name)
(append (function-definitions name)
(compiler-definitions name)))
@@ -546,6 +648,7 @@
for fn = (funcall reader fun-info)
when fn collect `((sb-c:defoptimizer ,name)
,(safe-function-source-location fn fun-name)))))
+) ;; End SBCL <= 0.9.6 compability
(defimplementation describe-symbol-for-emacs (symbol)
"Return a plist describing SYMBOL.
More information about the slime-cvs
mailing list