[slime-cvs] CVS slime

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv24556

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
	* swank-sbcl.lisp (call-with-debugger-hook): Correctly deal with
	case of HOOK being NIL.
	(make-definition-source-location): Somewhat simplified.
	(string-path-snippet): Removed, not needed anymore.


--- /project/slime/cvsroot/slime/ChangeLog	2009/09/24 11:30:46	1.1865
+++ /project/slime/cvsroot/slime/ChangeLog	2009/09/26 23:24:50	1.1866
@@ -1,3 +1,10 @@
+2009-09-27  Tobias C. Rittweiler <tcr at freebits.de>
+
+	* swank-sbcl.lisp (call-with-debugger-hook): Correctly deal with
+	case of HOOK being NIL.
+	(make-definition-source-location): Somewhat simplified.
+	(string-path-snippet): Removed, not needed anymore.
+
 2009-09-24  Stas Boukarev  <stassats at gmail.com>
 
 	* swank-sbcl.lisp (swank-compile-string): Ignore unused variable
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/24 11:30:46	1.251
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2009/09/26 23:24:50	1.252
@@ -742,15 +742,18 @@
         plist
       (cond
         (emacs-buffer
-         (let* ((*readtable* (guess-readtable-for-filename emacs-directory))
-                (pos (if form-path
-                         (with-debootstrapping
-                           (source-path-string-position form-path emacs-string))
-                         character-offset))
-                (snippet (string-path-snippet emacs-string form-path pos)))
-           (make-location `(:buffer ,emacs-buffer)
-                          `(:offset ,emacs-position ,pos)
-                          `(:snippet ,snippet))))
+         (let ((*readtable* (guess-readtable-for-filename emacs-directory)))
+           (multiple-value-bind (start end)
+               (if form-path
+                   (with-debootstrapping
+                     (source-path-string-position form-path emacs-string))
+                   (values character-offset most-positive-fixnum))
+             (make-location `(:buffer ,emacs-buffer)
+                            `(:offset ,emacs-position ,start)
+                            `(:snippet
+                              ,(subseq emacs-string
+                                       start
+                                       (min end (+ start *source-snippet-size*))))))))
         ((not pathname)
          `(:error ,(format nil "Source definition of ~A ~A not found"
                            (string-downcase type) name)))
@@ -765,18 +768,6 @@
                           `(:position ,(1+ pos))
                           `(:snippet ,snippet))))))))
 
-(defun string-path-snippet (string form-path position)
-  (if (null form-path)
-      (read-snippet-from-string string)
-      ;; If we have a form-path, use it to derive a more accurate
-      ;; snippet, so that we can point to the individual form rather
-      ;; than just the toplevel form.
-      (multiple-value-bind (data end)
-          (let ((*read-suppress* t))
-            (read-from-string string nil nil :start position))
-        (declare (ignore data))
-        (subseq string position (min end *source-snippet-size*)))))    
-    
 (defun source-file-position (filename write-date form-path character-offset)
   (let ((source (get-source-code filename write-date))
         (*readtable* (guess-readtable-for-filename filename)))
@@ -984,7 +975,7 @@
 
 (defimplementation call-with-debugger-hook (hook fun)
   (let ((*debugger-hook* hook)
-        (sb-ext:*invoke-debugger-hook* (make-invoke-debugger-hook hook))
+        (sb-ext:*invoke-debugger-hook* (and hook (make-invoke-debugger-hook hook)))
         #+#.(swank-backend::sbcl-with-new-stepper-p)
         (sb-ext:*stepper-hook*
          (lambda (condition)