Index: ChangeLog
===================================================================
RCS file: /project/slime/cvsroot/slime/ChangeLog,v
retrieving revision 1.1088
diff -u -r1.1088 ChangeLog
--- ChangeLog	29 Mar 2007 17:12:38 -0000	1.1088
+++ ChangeLog	31 Mar 2007 16:45:02 -0000
@@ -1,3 +1,9 @@
+2007-03-31  Luís Oliveira <loliveira@common-lisp.net>
+
+	* swank-backend.lisp (compute-sane-restarts): New interface.
+	* swank-clisp.lisp: Fix tabs and trailing whitespace.
+	(compute-sane-restarts): Implement new interface.
+
 2007-03-29  Nikodemus Siivola <nikodemus@random-state.net>
 
 	* swank-sbcl.lisp (swank-compile-string): save the original
@@ -1624,7 +1630,7 @@
 	* swank.asd: Set *source-directory* to the asdf component dir.
 
 2006-07-01  Luís Oliveira  <loliveira@common-lisp.net>
- 
+
 	* swank-sbcl.lisp (locate-compiler-note): Change first branch to
  	handle the changes introduced by the previous patch to
  	swank-compile-string.
Index: swank-backend.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-backend.lisp,v
retrieving revision 1.114
diff -u -r1.114 swank-backend.lisp
--- swank-backend.lisp	25 Feb 2007 18:19:55 -0000	1.114
+++ swank-backend.lisp	31 Mar 2007 16:45:03 -0000
@@ -600,6 +600,13 @@
 debugger.  If END is nil, return the frames from START to the end of
 the stack.")
 
+(definterface compute-sane-restarts (condition)
+  "This is an opportunity for Lisps such as CLISP to remove
+unwanted restarts from the output of CL:COMPUTE-RESTARTS,
+otherwise it should simply call CL:COMPUTE-RESTARTS, which is
+what the default implementation does."
+  (compute-restarts condition))
+
 (definterface print-frame (frame stream)
   "Print frame to stream.")
 
Index: swank-clisp.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank-clisp.lisp,v
retrieving revision 1.62
diff -u -r1.62 swank-clisp.lisp
--- swank-clisp.lisp	12 Jan 2007 15:12:23 -0000	1.62
+++ swank-clisp.lisp	31 Mar 2007 16:45:04 -0000
@@ -1,3 +1,5 @@
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
+
 ;;;; SWANK support for CLISP.
 
 ;;;; Copyright (C) 2003, 2004 W. Jenkner, V. Sedach
@@ -47,20 +49,20 @@
     (and (find-package :clos)
          (eql :external
               (nth-value 1 (find-symbol (string ':standard-slot-definition)
-					:clos))))
+                                        :clos))))
     "True in those CLISP images which have a complete MOP implementation."))
 
 #+#.(cl:if swank-backend::*have-mop* '(cl:and) '(cl:or))
 (progn
   (import-swank-mop-symbols :clos '(:slot-definition-documentation))
-  
+
   (defun swank-mop:slot-definition-documentation (slot)
     (clos::slot-definition-documentation slot)))
 
 #-#.(cl:if swank-backend::*have-mop* '(and) '(or))
 (defclass swank-mop:standard-slot-definition ()
   ()
-  (:documentation 
+  (:documentation
    "Dummy class created so that swank.lisp will compile and load."))
 
 ;; #+#.(cl:if (cl:find-package "LINUX") '(and) '(or))
@@ -68,15 +70,15 @@
 ;;   (defmacro with-blocked-signals ((&rest signals) &body body)
 ;;     (ext:with-gensyms ("SIGPROCMASK" ret mask)
 ;;       `(multiple-value-bind (,ret ,mask)
-;; 	   (linux:sigprocmask-set-n-save
-;; 	    ,linux:SIG_BLOCK
-;; 	    ,(do ((sigset (linux:sigset-empty)
-;; 			  (linux:sigset-add sigset (the fixnum (pop signals)))))
-;; 		 ((null signals) sigset)))
-;; 	 (linux:check-res ,ret 'linux:sigprocmask-set-n-save)
-;; 	 (unwind-protect
-;; 	      (progn ,@body)
-;; 	   (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
+;;            (linux:sigprocmask-set-n-save
+;;             ,linux:SIG_BLOCK
+;;             ,(do ((sigset (linux:sigset-empty)
+;;                           (linux:sigset-add sigset (the fixnum (pop signals)))))
+;;                  ((null signals) sigset)))
+;;          (linux:check-res ,ret 'linux:sigprocmask-set-n-save)
+;;          (unwind-protect
+;;               (progn ,@body)
+;;            (linux:sigprocmask-set ,linux:SIG_SETMASK ,mask nil)))))
 
 ;;   (defimplementation call-without-interrupts (fn)
 ;;     (with-blocked-signals (#.linux:SIGINT) (funcall fn))))
@@ -86,11 +88,11 @@
   (funcall fn))
 
 (let ((getpid (or (find-symbol "PROCESS-ID" :system)
-		  ;; old name prior to 2005-03-01, clisp <= 2.33.2
-		  (find-symbol "PROGRAM-ID" :system)
-		  #+win32 ; integrated into the above since 2005-02-24
-		  (and (find-package :win32) ; optional modules/win32
-		       (find-symbol "GetCurrentProcessId" :win32)))))
+                  ;; old name prior to 2005-03-01, clisp <= 2.33.2
+                  (find-symbol "PROGRAM-ID" :system)
+                  #+win32 ; integrated into the above since 2005-02-24
+                  (and (find-package :win32) ; optional modules/win32
+                       (find-symbol "GetCurrentProcessId" :win32)))))
   (defimplementation getpid () ; a required interface
     (cond
       (getpid (funcall getpid))
@@ -104,8 +106,7 @@
   (setf (ext:default-directory) directory)
   (namestring (setf *default-pathname-defaults* (ext:default-directory))))
 
-
-;;; TCP Server
+;;;; TCP Server
 
 (defimplementation create-socket (host port)
   (declare (ignore host))
@@ -116,21 +117,21 @@
 
 (defimplementation close-socket (socket)
   (socket:socket-server-close socket))
-  
+
 (defimplementation accept-connection (socket
-				      &key external-format buffering timeout)
+                                      &key external-format buffering timeout)
   (declare (ignore buffering timeout))
   (socket:socket-accept socket
-			:buffered nil ;; XXX should be t
-			:element-type 'character
-			:external-format external-format))
+                        :buffered nil ;; XXX should be t
+                        :element-type 'character
+                        :external-format external-format))
 
-;;; Coding systems
+;;;; Coding systems
 
 (defvar *external-format-to-coding-system*
-  '(((:charset "iso-8859-1" :line-terminator :unix) 
+  '(((:charset "iso-8859-1" :line-terminator :unix)
      "latin-1-unix" "iso-latin-1-unix" "iso-8859-1-unix")
-    ((:charset "iso-8859-1":latin-1) 
+    ((:charset "iso-8859-1":latin-1)
      "latin-1" "iso-latin-1" "iso-8859-1")
     ((:charset "utf-8") "utf-8")
     ((:charset "utf-8" :line-terminator :unix) "utf-8-unix")
@@ -140,22 +141,22 @@
     ((:charset "us-ascii" :line-terminator :unix) "us-ascii-unix")))
 
 (defimplementation find-external-format (coding-system)
-  (let ((args (car (rassoc-if (lambda (x) 
-				(member coding-system x :test #'equal))
-			      *external-format-to-coding-system*))))
+  (let ((args (car (rassoc-if (lambda (x)
+                                (member coding-system x :test #'equal))
+                              *external-format-to-coding-system*))))
     (and args (apply #'ext:make-encoding args))))
 
 
-;;; Swank functions
+;;;; Swank functions
 
 (defimplementation arglist (fname)
   (block nil
     (or (ignore-errors
-	  (let ((exp (function-lambda-expression fname)))
-	    (and exp (return (second exp)))))
-	(ignore-errors 
-	  (return (ext:arglist fname)))
-	:not-available)))
+          (let ((exp (function-lambda-expression fname)))
+            (and exp (return (second exp)))))
+        (ignore-errors
+          (return (ext:arglist fname)))
+        :not-available)))
 
 (defimplementation macroexpand-all (form)
   (ext:expand-form form))
@@ -165,43 +166,43 @@
 Return NIL if the symbol is unbound."
   (let ((result ()))
     (flet ((doc (kind)
-	     (or (documentation symbol kind) :not-documented))
-	   (maybe-push (property value)
-	     (when value
-	       (setf result (list* property value result)))))
+             (or (documentation symbol kind) :not-documented))
+           (maybe-push (property value)
+             (when value
+               (setf result (list* property value result)))))
       (maybe-push :variable (when (boundp symbol) (doc 'variable)))
       (when (fboundp symbol)
-	(maybe-push
-	 ;; Report WHEN etc. as macros, even though they may be
-	 ;; implemented as special operators.
-	 (if (macro-function symbol) :macro
-	     (typecase (fdefinition symbol)
-	       (generic-function :generic-function)
-	       (function         :function)
-	       ;; (type-of 'progn) -> ext:special-operator
-	       (t                :special-operator)))
-	 (doc 'function)))
+        (maybe-push
+         ;; Report WHEN etc. as macros, even though they may be
+         ;; implemented as special operators.
+         (if (macro-function symbol) :macro
+             (typecase (fdefinition symbol)
+               (generic-function :generic-function)
+               (function         :function)
+               ;; (type-of 'progn) -> ext:special-operator
+               (t                :special-operator)))
+         (doc 'function)))
       (when (or (get symbol 'system::setf-function) ; e.g. #'(setf elt)
-		(get symbol 'system::setf-expander)); defsetf
-	(maybe-push :setf (doc 'setf)))
+                (get symbol 'system::setf-expander)); defsetf
+        (maybe-push :setf (doc 'setf)))
       (when (or (get symbol 'system::type-symbol); cf. clisp/src/describe.lisp
-		(get symbol 'system::defstruct-description)
-		(get symbol 'system::deftype-expander))
-	(maybe-push :type (doc 'type))) ; even for 'structure
+                (get symbol 'system::defstruct-description)
+                (get symbol 'system::deftype-expander))
+        (maybe-push :type (doc 'type))) ; even for 'structure
       (when (find-class symbol nil)
-	(maybe-push :class (doc 'type)))
+        (maybe-push :class (doc 'type)))
       ;; Let this code work compiled in images without FFI
       (let ((types (load-time-value
-		    (and (find-package "FFI")
-			 (symbol-value 
-			  (find-symbol "*C-TYPE-TABLE*" "FFI"))))))
-	;; Use ffi::*c-type-table* so as not to suffer the overhead of
-	;; (ignore-errors (ffi:parse-c-type symbol)) for 99.9% of symbols
-	;; which are not FFI type names.
-	(when (and types (nth-value 1 (gethash symbol types)))
-	  ;; Maybe use (case (head (ffi:deparse-c-type)))
-	  ;; to distinguish struct and union types?
-	  (maybe-push :alien-type :not-documented)))
+                    (and (find-package "FFI")
+                         (symbol-value
+                          (find-symbol "*C-TYPE-TABLE*" "FFI"))))))
+        ;; Use ffi::*c-type-table* so as not to suffer the overhead of
+        ;; (ignore-errors (ffi:parse-c-type symbol)) for 99.9% of symbols
+        ;; which are not FFI type names.
+        (when (and types (nth-value 1 (gethash symbol types)))
+          ;; Maybe use (case (head (ffi:deparse-c-type)))
+          ;; to distinguish struct and union types?
+          (maybe-push :alien-type :not-documented)))
       result)))
 
 (defimplementation describe-definition (symbol namespace)
@@ -213,32 +214,32 @@
 
 (defun fspec-pathname (symbol)
   (let ((path (documentation symbol 'sys::file))
-	lines)
+        lines)
     (when (consp path)
       (psetq path (car path)
-	     lines (cdr path)))
+             lines (cdr path)))
     (when (and path
-	       (member (pathname-type path)
-		       custom:*compiled-file-types* :test #'equal))
+               (member (pathname-type path)
+                       custom:*compiled-file-types* :test #'equal))
       (setq path
-	    (loop for suffix in custom:*source-file-types*
-	       thereis (probe-file (make-pathname :defaults path
-						  :type suffix)))))
+            (loop for suffix in custom:*source-file-types*
+               thereis (probe-file (make-pathname :defaults path
+                                                  :type suffix)))))
     (values path lines)))
 
 (defun fspec-location (fspec)
   (multiple-value-bind (file 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))))))
+           (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))))))
 
 (defimplementation find-definitions (name)
   (list (list name (fspec-location name))))
@@ -250,13 +251,13 @@
 
 (defimplementation call-with-debugging-environment (debugger-loop-fn)
   (let* (;;(sys::*break-count* (1+ sys::*break-count*))
-	 ;;(sys::*driver* debugger-loop-fn)
-	 ;;(sys::*fasoutput-stream* nil)
-	 (*sldb-backtrace* 
-	  (nthcdr 3 (member (sys::the-frame) (sldb-backtrace)))))
+         ;;(sys::*driver* debugger-loop-fn)
+         ;;(sys::*fasoutput-stream* nil)
+         (*sldb-backtrace*
+          (nthcdr 3 (member (sys::the-frame) (sldb-backtrace)))))
     (funcall debugger-loop-fn)))
 
-(defun nth-frame (index) 
+(defun nth-frame (index)
   (nth index *sldb-backtrace*))
 
 (defun sldb-backtrace ()
@@ -272,7 +273,7 @@
   (member (frame-type frame) '(stack-value bind-var bind-env)))
 
 (defun frame-to-string (frame)
-  (with-output-to-string (s) 
+  (with-output-to-string (s)
     (sys::describe-frame s frame)))
 
 (defun frame-type (frame)
@@ -304,47 +305,54 @@
 
 (defun frame-string-type (string)
   (cadr (assoc-if (lambda (pattern) (is-prefix-p pattern string))
-		  *frame-prefixes*)))
+                  *frame-prefixes*)))
 
 (defimplementation compute-backtrace (start end)
   (let* ((bt *sldb-backtrace*)
-	 (len (length bt)))
+         (len (length bt)))
     (subseq bt start (min (or end len) len))))
 
+;;; CLISP's REPL sets up an ABORT restart that kills SWANK.  Here we
+;;; can omit that restart so that users don't select it by mistake.
+(defimplementation compute-sane-restarts (condition)
+  ;; The outermost restart is specified to be the last element of the
+  ;; list, hopefully that's our unwanted ABORT restart.
+  (butlast (compute-restarts condition)))
+
 (defimplementation print-frame (frame stream)
   (let ((str (frame-to-string frame)))
-    ;;(format stream "~a " (frame-string-type str))
-    (write-string (extract-frame-line str) 
-		  stream)))
+    ;; (format stream "~A " (frame-string-type str))
+    (write-string (extract-frame-line str)
+                  stream)))
 
 (defun extract-frame-line (frame-string)
   (let ((s frame-string))
     (trim-whitespace
      (case (frame-string-type s)
        ((eval special-op)
-	(string-match "EVAL frame .*for form \\(.*\\)" s 1))
+        (string-match "EVAL frame .*for form \\(.*\\)" s 1))
        (apply
-	(string-match "APPLY frame for call \\(.*\\)" s 1))
+        (string-match "APPLY frame for call \\(.*\\)" s 1))
        ((compiled-fun sys-fun fun)
-	(extract-function-name s))
+        (extract-function-name s))
        (t s)))))
 
 (defun extract-function-name (string)
   (let ((1st (car (split-frame-string string))))
     (or (string-match (format nil "^<1>[ ~%]*#<[-A-Za-z]* \\(.*\\)>")
-		      1st
-		      1)
-	(string-match (format nil "^<1>[ ~%]*\\(.*\\)") 1st 1)
-	1st)))
+                      1st
+                      1)
+        (string-match (format nil "^<1>[ ~%]*\\(.*\\)") 1st 1)
+        1st)))
 
 (defun split-frame-string (string)
-  (let ((rx (format nil "~%\\(~{~a~^\\|~}\\)"
-		    (mapcar #'car *frame-prefixes*))))
+  (let ((rx (format nil "~%\\(~{~A~^\\|~}\\)"
+                    (mapcar #'car *frame-prefixes*))))
     (loop for pos = 0 then (1+ (regexp:match-start match))
-	  for match = (regexp:match rx string :start pos)
-	  if match collect (subseq string pos (regexp:match-start match))
-	  else collect (subseq string pos)
-	  while match)))
+          for match = (regexp:match rx string :start pos)
+          if match collect (subseq string pos (regexp:match-start match))
+          else collect (subseq string pos)
+          while match)))
 
 (defun string-match (pattern string n)
   (let* ((match (nth-value n (regexp:match pattern string))))
@@ -356,44 +364,44 @@
 (defimplementation eval-in-frame (form frame-number)
   (sys::eval-at (nth-frame frame-number) form))
 
-(defimplementation frame-locals (frame-number) 
+(defimplementation frame-locals (frame-number)
   (let ((frame (nth-frame frame-number)))
     (loop for i below (%frame-count-vars frame)
-	  collect (list :name (%frame-var-name frame i)
-			:value (%frame-var-value frame i)
-			:id 0))))
+          collect (list :name (%frame-var-name frame i)
+                        :value (%frame-var-value frame i)
+                        :id 0))))
 
 (defimplementation frame-var-value (frame var)
   (%frame-var-value (nth-frame frame) var))
 
-;; Interpreter-Variablen-Environment has the shape
-;; NIL or #(v1 val1 ... vn valn NEXT-ENV).
+;;; Interpreter-Variablen-Environment has the shape
+;;; NIL or #(v1 val1 ... vn valn NEXT-ENV).
 
 (defun %frame-count-vars (frame)
   (cond ((sys::eval-frame-p frame)
-	 (do ((venv (frame-venv frame) (next-venv venv))
-	      (count 0 (+ count (/ (1- (length venv)) 2))))
-	     ((not venv) count)))
-	((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
-	 (length (%parse-stack-values frame)))
-	(t 0)))
+         (do ((venv (frame-venv frame) (next-venv venv))
+              (count 0 (+ count (/ (1- (length venv)) 2))))
+             ((not venv) count)))
+        ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+         (length (%parse-stack-values frame)))
+        (t 0)))
 
 (defun %frame-var-name (frame i)
   (cond ((sys::eval-frame-p frame)
-	 (nth-value 0 (venv-ref (frame-venv frame) i)))
-	(t (format nil "~D" i))))
+         (nth-value 0 (venv-ref (frame-venv frame) i)))
+        (t (format nil "~D" i))))
 
 (defun %frame-var-value (frame i)
   (cond ((sys::eval-frame-p frame)
-	 (let ((name (venv-ref (frame-venv frame) i)))
-	   (multiple-value-bind (v c) (ignore-errors (sys::eval-at frame name))
-	     (if c
-		 (format-sldb-condition c)
-		 v))))
-	((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
-	 (let ((str (nth i (%parse-stack-values frame))))
-	   (trim-whitespace (subseq str 2))))
-	(t (break "Not implemented"))))
+         (let ((name (venv-ref (frame-venv frame) i)))
+           (multiple-value-bind (v c) (ignore-errors (sys::eval-at frame name))
+             (if c
+                 (format-sldb-condition c)
+                 v))))
+        ((member (frame-type frame) '(compiled-fun sys-fun fun special-op))
+         (let ((str (nth i (%parse-stack-values frame))))
+           (trim-whitespace (subseq str 2))))
+        (t (break "Not implemented"))))
 
 (defun frame-venv (frame)
   (let ((env (sys::eval-at frame '(sys::the-environment))))
@@ -406,28 +414,28 @@
 Return two values: NAME and VALUE"
   (let ((idx (* i 2)))
     (if (< idx (1- (length env)))
-	(values (svref env idx) (svref env (1+ idx)))
-	(venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))
+        (values (svref env idx) (svref env (1+ idx)))
+        (venv-ref (next-venv env) (- i (/ (1- (length env)) 2))))))
 
 (defun %parse-stack-values (frame)
   (labels ((next (fp) (sys::frame-down-1 fp 1))
-	   (parse (fp accu)
-	     (let ((str (frame-to-string fp)))
-	       (cond ((is-prefix-p "- " str)
-		      (parse  (next fp) (cons str accu)))
-		     ((is-prefix-p "<1> " str)
-		      ;;(when (eq (frame-type frame) 'compiled-fun)
-		      ;;  (pop accu))
-		      (dolist (str (cdr (split-frame-string str)))
-			(when (is-prefix-p "- " str)
-			  (push str accu)))
-		      (nreverse accu))
-		     (t (parse (next fp) accu))))))
+           (parse (fp accu)
+             (let ((str (frame-to-string fp)))
+               (cond ((is-prefix-p "- " str)
+                      (parse  (next fp) (cons str accu)))
+                     ((is-prefix-p "<1> " str)
+                      ;;(when (eq (frame-type frame) 'compiled-fun)
+                      ;;  (pop accu))
+                      (dolist (str (cdr (split-frame-string str)))
+                        (when (is-prefix-p "- " str)
+                          (push str accu)))
+                      (nreverse accu))
+                     (t (parse (next fp) accu))))))
     (parse (next frame) '())))
 
 (defun is-prefix-p (pattern string)
   (not (mismatch pattern string :end2 (min (length pattern)
-					   (length string)))))
+                                           (length string)))))
 
 (defimplementation frame-catch-tags (index)
   (declare (ignore index))
@@ -440,20 +448,20 @@
   (sys::redo-eval-frame (nth-frame index)))
 
 (defimplementation frame-source-location-for-emacs (index)
-  `(:error 
-    ,(format nil "frame-source-location not implemented. (frame: ~A)" 
-	     (nth-frame index))))
+  `(:error
+    ,(format nil "frame-source-location not implemented. (frame: ~A)"
+             (nth-frame index))))
 
-;;; Profiling
+;;;; Profiling
 
 (defimplementation profile (fname)
-  (eval `(mon:monitor ,fname)))		;monitor is a macro
+  (eval `(mon:monitor ,fname)))         ;monitor is a macro
 
 (defimplementation profiled-functions ()
   mon:*monitored-functions*)
 
 (defimplementation unprofile (fname)
-  (eval `(mon:unmonitor ,fname)))	;unmonitor is a macro
+  (eval `(mon:unmonitor ,fname)))       ;unmonitor is a macro
 
 (defimplementation unprofile-all ()
   (mon:unmonitor))
@@ -468,19 +476,19 @@
   (declare (ignore callers-p methods))
   (mon:monitor-all package))
 
-;;; Handle compiler conditions (find out location of error etc.)
+;;;; Handle compiler conditions (find out location of error etc.)
 
 (defmacro compile-file-frobbing-notes ((&rest args) &body body)
   "Pass ARGS to COMPILE-FILE, send the compiler notes to
 *STANDARD-INPUT* and frob them in BODY."
   `(let ((*error-output* (make-string-output-stream))
-	 (*compile-verbose* t))
+         (*compile-verbose* t))
      (multiple-value-prog1
       (compile-file ,@args)
-      (handler-case  
+      (handler-case
        (with-input-from-string
-	(*standard-input* (get-output-stream-string *error-output*))
-	,@body)
+        (*standard-input* (get-output-stream-string *error-output*))
+        ,@body)
        (sys::simple-end-of-file () nil)))))
 
 (defvar *orig-c-warn* (symbol-function 'system::c-warn))
@@ -492,7 +500,7 @@
   "(dynamic-flet ((NAME FUNCTION) ...) BODY ...)
 Execute BODY with NAME's function slot set to FUNCTION."
   `(ext:letf* ,(loop for (name function) in names-functions
-		     collect `((symbol-function ',name) ,function))
+                     collect `((symbol-function ',name) ,function))
     ,@body))
 
 (defvar *buffer-name* nil)
@@ -501,22 +509,22 @@
 (defun compiler-note-location ()
   "Return the current compiler location."
   (let ((lineno1 sys::*compile-file-lineno1*)
-	(lineno2 sys::*compile-file-lineno2*)
-	(file sys::*compile-file-truename*))
+        (lineno2 sys::*compile-file-lineno2*)
+        (file sys::*compile-file-truename*))
     (cond ((and file lineno1 lineno2)
-	   (make-location (list ':file (namestring file))
-			  (list ':line lineno1)))
-	  (*buffer-name*
-	   (make-location (list ':buffer *buffer-name*) 
-			  (list ':position *buffer-offset*)))
-	  (t
-	   (list :error "No error location available")))))
+           (make-location (list ':file (namestring file))
+                          (list ':line lineno1)))
+          (*buffer-name*
+           (make-location (list ':buffer *buffer-name*)
+                          (list ':position *buffer-offset*)))
+          (t
+           (list :error "No error location available")))))
 
 (defun signal-compiler-warning (cstring args severity orig-fn)
   (signal (make-condition 'compiler-condition
-			  :severity severity
-			  :message (apply #'format nil cstring args)
-			  :location (compiler-note-location)))
+                          :severity severity
+                          :message (apply #'format nil cstring args)
+                          :location (compiler-note-location)))
   (apply orig-fn cstring args))
 
 (defun c-warn (cstring &rest args)
@@ -532,36 +540,36 @@
 (defimplementation call-with-compilation-hooks (function)
   (handler-bind ((warning #'handle-notification-condition))
     (dynamic-flet ((system::c-warn #'c-warn)
-		   (system::c-style-warn #'c-style-warn)
-		   (system::c-error #'c-error))
+                   (system::c-style-warn #'c-style-warn)
+                   (system::c-error #'c-error))
       (funcall function))))
 
 (defun handle-notification-condition (condition)
   "Handle a condition caused by a compiler warning."
   (signal (make-condition 'compiler-condition
-			  :original-condition condition
-			  :severity :warning
-			  :message (princ-to-string condition)
-			  :location (compiler-note-location))))
+                          :original-condition condition
+                          :severity :warning
+                          :message (princ-to-string condition)
+                          :location (compiler-note-location))))
 
 (defimplementation swank-compile-file (filename load-p external-format)
   (with-compilation-hooks ()
     (with-compilation-unit ()
-      (let ((fasl-file (compile-file filename 
-				     :external-format external-format)))
-	(when (and load-p fasl-file)
-	  (load fasl-file))
-	nil))))
+      (let ((fasl-file (compile-file filename
+                                     :external-format external-format)))
+        (when (and load-p fasl-file)
+          (load fasl-file))
+        nil))))
 
 (defimplementation swank-compile-string (string &key buffer position directory)
   (declare (ignore directory))
   (with-compilation-hooks ()
     (let ((*buffer-name* buffer)
-	  (*buffer-offset* position))
+          (*buffer-offset* position))
       (funcall (compile nil (read-from-string
                              (format nil "(~S () ~A)" 'lambda string)))))))
 
-;;; Portable XREF from the CMU AI repository.
+;;;; Portable XREF from the CMU AI repository.
 
 (setq pxref::*handle-package-forms* '(cl:in-package))
 
@@ -584,40 +592,40 @@
 
 (when (find-package :swank-loader)
   (setf (symbol-function (intern "USER-INIT-FILE" :swank-loader))
-	(lambda ()
-	  (let ((home (user-homedir-pathname)))
-	    (and (ext:probe-directory home)
-		 (probe-file (format nil "~A/.swank.lisp"
-				     (namestring (truename home)))))))))
+        (lambda ()
+          (let ((home (user-homedir-pathname)))
+            (and (ext:probe-directory home)
+                 (probe-file (format nil "~A/.swank.lisp"
+                                     (namestring (truename home)))))))))
 
-;; Don't set *debugger-hook* to nil on break.
-(ext:without-package-lock () 
+;;; Don't set *debugger-hook* to nil on break.
+(ext:without-package-lock ()
  (defun break (&optional (format-string "Break") &rest args)
    (if (not sys::*use-clcs*)
        (progn
-	 (terpri *error-output*)
-	 (apply #'format *error-output*
-		(concatenate 'string "*** - " format-string)
-		args)
-	 (funcall ext:*break-driver* t))
+         (terpri *error-output*)
+         (apply #'format *error-output*
+                (concatenate 'string "*** - " format-string)
+                args)
+         (funcall ext:*break-driver* t))
        (let ((condition
-	      (make-condition 'simple-condition
-			      :format-control format-string
-			      :format-arguments args))
-	     ;;(*debugger-hook* nil)
-	     ;; Issue 91
-	     )				
-	 (ext:with-restarts
-	     ((continue
-	       :report (lambda (stream)
-			 (format stream (sys::text "Return from ~S loop")
-				 'break))
-	       ()))
-	   (with-condition-restarts condition (list (find-restart 'continue))
-				    (invoke-debugger condition)))))
+              (make-condition 'simple-condition
+                              :format-control format-string
+                              :format-arguments args))
+             ;;(*debugger-hook* nil)
+             ;; Issue 91
+             )
+         (ext:with-restarts
+             ((continue
+               :report (lambda (stream)
+                         (format stream (sys::text "Return from ~S loop")
+                                 'break))
+               ()))
+           (with-condition-restarts condition (list (find-restart 'continue))
+                                    (invoke-debugger condition)))))
    nil))
 
-;;; Inspecting
+;;;; Inspecting
 
 (defclass clisp-inspector (inspector) ())
 
@@ -627,31 +635,30 @@
 (defmethod inspect-for-emacs ((o t) (inspector clisp-inspector))
   (declare (ignore inspector))
   (let* ((*print-array* nil) (*print-pretty* t)
-	 (*print-circle* t) (*print-escape* t)
-	 (*print-lines* custom:*inspect-print-lines*)
-	 (*print-level* custom:*inspect-print-level*)
-	 (*print-length* custom:*inspect-print-length*)
-	 (sys::*inspect-all* (make-array 10 :fill-pointer 0 :adjustable t))
-	 (tmp-pack (make-package (gensym "INSPECT-TMP-PACKAGE-")))
-	 (*package* tmp-pack)
-	 (sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
+         (*print-circle* t) (*print-escape* t)
+         (*print-lines* custom:*inspect-print-lines*)
+         (*print-level* custom:*inspect-print-level*)
+         (*print-length* custom:*inspect-print-length*)
+         (sys::*inspect-all* (make-array 10 :fill-pointer 0 :adjustable t))
+         (tmp-pack (make-package (gensym "INSPECT-TMP-PACKAGE-")))
+         (*package* tmp-pack)
+         (sys::*inspect-unbound-value* (intern "#<unbound>" tmp-pack)))
     (let ((inspection (sys::inspect-backend o)))
-      (values (format nil "~S~% ~A~{~%~A~}" o 
-		      (sys::insp-title inspection)
-		      (sys::insp-blurb inspection))
+      (values (format nil "~S~% ~A~{~%~A~}" o
+                      (sys::insp-title inspection)
+                      (sys::insp-blurb inspection))
               (loop with count = (sys::insp-num-slots inspection)
-                    for i below count 
-		    append (multiple-value-bind (value name)
-			       (funcall (sys::insp-nth-slot inspection) 
-					i)
-			     `((:value ,name) " = " (:value ,value) 
-			       (:newline))))))))
+                    for i below count
+                    append (multiple-value-bind (value name)
+                               (funcall (sys::insp-nth-slot inspection)
+                                        i)
+                             `((:value ,name) " = " (:value ,value)
+                               (:newline))))))))
 
 (defimplementation quit-lisp ()
   #+lisp=cl (ext:quit)
   #-lisp=cl (lisp:quit))
 
-
 ;;;; Weak hashtables
 
 (defimplementation make-weak-key-hash-table (&rest args)
Index: swank.lisp
===================================================================
RCS file: /project/slime/cvsroot/slime/swank.lisp,v
retrieving revision 1.464
diff -u -r1.464 swank.lisp
--- swank.lisp	29 Mar 2007 17:08:48 -0000	1.464
+++ swank.lisp	31 Mar 2007 16:45:13 -0000
@@ -2810,7 +2810,7 @@
 
 (defun debug-in-emacs (condition)
   (let ((*swank-debugger-condition* condition)
-        (*sldb-restarts* (compute-restarts condition))
+        (*sldb-restarts* (compute-sane-restarts condition))
         (*package* (or (and (boundp '*buffer-package*)
                             (symbol-value '*buffer-package*))
                        *package*))
@@ -2819,14 +2819,14 @@
         (*swank-state-stack* (cons :swank-debugger-hook *swank-state-stack*)))
     (force-user-output)
     (call-with-debugging-environment
-     (lambda () 
+     (lambda ()
        (with-bindings *sldb-printer-bindings*
          (sldb-loop *sldb-level*))))))
 
 (defun sldb-loop (level)
   (unwind-protect
        (catch 'sldb-enter-default-debugger
-         (send-to-emacs 
+         (send-to-emacs
           (list* :debug (current-thread) level
                  (debugger-info-for-emacs 0 *sldb-initial-frames*)))
          (loop (catch 'sldb-loop-catcher
