[slime-cvs] CVS update: slime/ChangeLog slime/swank-sbcl.lisp

[Juho Snellman]

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
2005-12-06  Juho Snellman <jsnell at iki.fi>
        * swank-sbcl.lisp (function-source-location,
          safe-function-source-location): Oops, define these functions 
          also for the >0.9.6 case. Fixes broken sldb-show-source on 
          SBCL 0.9.7.


Date: Tue Dec  6 00:01:55 2005
Author: jsnellman

Index: slime/ChangeLog
diff -u slime/ChangeLog:1.815 slime/ChangeLog:1.816
--- slime/ChangeLog:1.815	Mon Dec  5 21:20:43 2005
+++ slime/ChangeLog	Tue Dec  6 00:01:49 2005
@@ -1,3 +1,9 @@
+2005-12-06  Juho Snellman <jsnell at iki.fi>
+        * swank-sbcl.lisp (function-source-location,
+          safe-function-source-location): Oops, define these functions 
+          also for the >0.9.6 case. Fixes broken sldb-show-source on 
+          SBCL 0.9.7.
+
 2005-12-05  Helmut Eller  <heller at common-lisp.net>
 
 	* slime.el (slime-find-coding-system): Use check-coding-system


Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.150 slime/swank-sbcl.lisp:1.151
--- slime/swank-sbcl.lisp:1.150	Sat Nov 12 00:43:43 2005
+++ slime/swank-sbcl.lisp	Tue Dec  6 00:01:50 2005
@@ -400,10 +400,14 @@
 ;;; 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")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defun new-definition-source-p ()
+    (if (find-symbol "FIND-DEFINITION-SOURCES-BY-NAME" "SB-INTROSPECT")
            '(and)
-           '(or))
+        '(or))))
+
+;;; SBCL > 0.9.6
+#+#.(swank-backend::new-definition-source-p)
 (progn
 
 (defparameter *definition-types*
@@ -491,13 +495,22 @@
     (with-input-from-string (s source)
       (read-snippet s position))))
 
+(defun function-source-location (function &optional name)
+  (declare (type function function))
+  (let ((location (sb-introspect:find-definition-source function)))
+    (make-definition-source-location location :function name)))
+
+(defun safe-function-source-location (fun name)
+  (if *debug-definition-finding*
+      (function-source-location fun name)
+      (handler-case (function-source-location fun name)
+        (error (e)
+          (list :error (format nil "Error: ~A" e))))))
 ) ;; 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))
+#-#.(swank-backend::new-definition-source-p)
 (progn
 (defimplementation find-definitions (name)
   (append (function-definitions name)