diff --git a/code/error.lisp b/code/error.lisp
index 462aa9e574e1c9c7d34c5b72e1e4645de4595f99..ccbe0150ca7cfad27f1811eb0fde4eadff901903 100644
--- a/code/error.lisp
+++ b/code/error.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.23 1993/06/24 14:09:41 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/error.lisp,v 1.24 1993/07/02 15:06:33 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -32,6 +32,7 @@
 	  ;; proposal has been accepted.
 	  *break-on-signals* *debugger-hook* signal handler-case handler-bind
 	  ignore-errors define-condition make-condition with-simple-restart
+	  with-condition-restarts
 	  restart-case restart-bind restart-name restart-name find-restart
 	  compute-restarts invoke-restart invoke-restart-interactively abort
 	  continue muffle-warning store-value use-value invoke-debugger restart
@@ -84,25 +85,49 @@
 
 ;;;; Restarts.
 
+;;; A list of lists of restarts.
+;;;
 (defvar *restart-clusters* '())
 
-(defun compute-restarts ()
+;;;  An ALIST (condition . restarts) which records the restarts currently
+;;; associated with Condition.
+;;;
+(defvar *condition-restarts* ())
+
+(defun compute-restarts (&optional condition)
   "Return a list of all the currently active restarts ordered from most
-   recently established to less recently established."
-  (copy-list (apply #'append *restart-clusters*)))
+   recently established to less recently established.  If Condition is
+   specified, then only restarts associated with Condition (or with no
+   condition) will be returned."
+  (let ((associated ())
+	(other ()))
+    (dolist (alist *condition-restarts*)
+      (if (eq (car alist) condition)
+	  (setq associated (cdr alist))
+	  (setq other (append (cdr alist) other))))
+    (collect ((res))
+      (dolist (restart-cluster *restart-clusters*)
+	(dolist (restart restart-cluster)
+	  (when (and (or (not condition)
+			 (member restart associated)
+			 (not (member restart other)))
+		     (funcall (restart-test-function restart) condition))
+	    (res restart))))
+      (res))))
+
 
 (defun restart-print (restart stream depth)
   (declare (ignore depth))
   (if *print-escape*
-      (format stream "#<~S.~X>"
-	      (type-of restart) (system:%primitive lisp::make-fixnum restart))
+      (print-unreadable-object (restart stream :type t :identity t))
       (restart-report restart stream)))
 
 (defstruct (restart (:print-function restart-print))
   name
   function
   report-function
-  interactive-function)
+  interactive-function
+  (test-function #'(lambda (cond) (declare (ignore cond)) t)))
 
 (setf (documentation 'restart-name 'function)
       "Returns the name of the given restart object.")
@@ -115,6 +140,21 @@
 			      (format stream "~S" restart)))))
            stream))
 
+(defmacro with-condition-restarts (condition-form restarts-form &body body)
+  "WITH-CONDITION-RESTARTS Condition-Form Restarts-Form Form*
+   Evaluates the Forms in a dynamic environment where the restarts in the list
+   Restarts-Form are associated with the condition returned by Condition-Form.
+   This allows FIND-RESTART, etc., to recognize restarts that are not related
+   to the error currently being debugged.  See also RESTART-CASE."
+  (let ((n-cond (gensym)))
+    `(let ((*condition-restarts*
+	    (cons (let ((,n-cond ,condition-form))
+		    (cons ,n-cond
+			  (append ,restarts-form
+				  (cdr (assoc ,n-cond *condition-restarts*)))))
+		  *condition-restarts*)))
+       ,@body)))
+
 (defmacro restart-bind (bindings &body forms)
   "Executes forms in a dynamic context where the given restart bindings are
    in effect.  Users probably want to use RESTART-CASE.  When clauses contain
@@ -136,15 +176,16 @@
 		*restart-clusters*)))
      ,@forms))
 
-(defun find-restart (name)
+(defun find-restart (name &optional condition)
   "Returns the first restart named name.  If name is a restart, it is returned
    if it is currently active.  If no such restart is found, nil is returned.
-   It is an error to supply nil as a name."
-  (dolist (restart-cluster *restart-clusters*)
-    (dolist (restart restart-cluster)
-      (when (or (eq restart name) (eq (restart-name restart) name))
-	(return-from find-restart restart)))))
-  
+   It is an error to supply nil as a name.  If Condition is specified and not
+   NIL, then only restarts associated with that condition (or with no
+   condition) will be returned."
+  (find-if #'(lambda (x)
+	       (or (eq x name)
+		   (eq (restart-name x) name)))
+	   (compute-restarts condition)))
 
 (defun invoke-restart (restart &rest values)
   "Calls the function associated with the given restart, passing any given
@@ -174,6 +215,9 @@
 		 '())))))
 
 
+#|
+This hack of using catch w/ conses should no longer be necessary...
+
 (defmacro restart-case (expression &body clauses)
   "(RESTART-CASE form
    {(case-name arg-list {keyword value}* body)}*)
@@ -236,9 +280,38 @@
 			     `(,tag
 			       (apply #'(lambda ,bvl ,@body) ,temp-var))))
 		       data)))))))
-#|
-This macro doesn't work in our system due to lossage in closing over tags.
-The previous version is uglier, but it sets up unique run-time tags.
+|#
+
+(eval-when (compile load eval)
+;;; Wrap the restart-case expression in a with-condition-restarts if
+;;; appropriate.  Gross, but it's what the book seems to say...
+;;;
+(defun munge-restart-case-expression (expression data)
+  (let ((exp (macroexpand expression)))
+    (if (consp exp)
+	(let* ((name (car exp))
+	       (args (if (eq name 'cerror) (cddr exp) (cdr exp))))
+	  (if (member name '(signal error cerror warn))
+	      (once-only ((n-cond `(coerce-to-condition
+				    ,(first args)
+				    (list ,@(rest args))
+				    ',(case name
+					(warn 'simple-warning)
+					(signal 'simple-condition)
+					(t 'simple-error))
+				    ',name)))
+		`(with-condition-restarts
+		     ,n-cond
+		     (list ,@(mapcar #'(lambda (da)
+					 `(find-restart ',(nth 0 da)))
+				     data))
+		   ,(if (eq name 'cerror)
+			`(cerror ,(second expression) ,n-cond)
+			`(,name ,n-cond))))
+	      expression))
+	expression)))
+
+); eval-when (compile load eval)
 
 (defmacro restart-case (expression &body clauses)
   "(RESTART-CASE form
@@ -246,8 +319,10 @@ The previous version is uglier, but it sets up unique run-time tags.
    The form is evaluated in a dynamic context where the clauses have special
    meanings as points to which control may be transferred (see INVOKE-RESTART).
    When clauses contain the same case-name, FIND-RESTART will find the first
-   such clause."
-  (flet ((transform-keywords (&key report interactive)
+   such clause.  If Expression is a call to SIGNAL, ERROR, CERROR or WARN (or
+   macroexpands into such) then the signalled condition will be associated with
+   the new restarts."
+  (flet ((transform-keywords (&key report interactive test)
 	   (let ((result '()))
 	     (when report
 	       (setq result (list* (if (stringp report)
@@ -260,45 +335,55 @@ The previous version is uglier, but it sets up unique run-time tags.
 	       (setq result (list* `#',interactive
 				   :interactive-function
 				   result)))
+	     (when test
+	       (setq result (list* `#',test
+				   :test-function
+				   result)))
 	     (nreverse result))))
     (let ((block-tag (gensym))
 	  (temp-var  (gensym))
 	  (data
-	    (mapcar #'(lambda (clause)
-			(with-keyword-pairs ((report interactive &rest forms)
-					     (cddr clause))
-			  (list (car clause)			   ;name=0
-				(gensym)			   ;tag=1
-				(transform-keywords :report report ;keywords=2
-						    :interactive interactive)
-				(cadr clause)			   ;bvl=3
-				forms)))			   ;body=4
-		    clauses)))
+	   (mapcar #'(lambda (clause)
+		       (with-keyword-pairs ((report interactive test
+						    &rest forms)
+					    (cddr clause))
+			 (list (car clause) ;name=0
+			       (gensym) ;tag=1
+			       (transform-keywords :report report ;keywords=2
+						   :interactive interactive
+						   :test test)
+			       (cadr clause) ;bvl=3
+			       forms))) ;body=4
+		   clauses)))
       `(block ,block-tag
 	 (let ((,temp-var nil))
 	   (tagbody
-	     (restart-bind
-	       ,(mapcar #'(lambda (datum)
-			    (let ((name (nth 0 datum))
-				  (tag  (nth 1 datum))
-				  (keys (nth 2 datum)))
-			      `(,name #'(lambda (&rest temp)
-					  (setq ,temp-var temp)
-					  (go ,tag))
-				,@keys)))
-			data)
-	       (return-from ,block-tag ,expression))
-	     ,@(mapcan #'(lambda (datum)
-			   (let ((tag  (nth 1 datum))
-				 (bvl  (nth 3 datum))
-				 (body (nth 4 datum)))
-			     (list tag
-				   `(return-from ,block-tag
-				      (apply #'(lambda ,bvl ,@body)
-					     ,temp-var)))))
-		       data)))))))
-|#
-
+	    (restart-bind
+		,(mapcar #'(lambda (datum)
+			     (let ((name (nth 0 datum))
+				   (tag  (nth 1 datum))
+				   (keys (nth 2 datum)))
+			       `(,name #'(lambda (&rest temp)
+					   (setq ,temp-var temp)
+					   (go ,tag))
+				       ,@keys)))
+			 data)
+	      (return-from ,block-tag
+			   ,(munge-restart-case-expression expression data)))
+	    ,@(mapcan #'(lambda (datum)
+			  (let ((tag  (nth 1 datum))
+				(bvl  (nth 3 datum))
+				(body (nth 4 datum)))
+			    (list tag
+				  `(return-from ,block-tag
+						(apply #'(lambda ,bvl ,@body)
+						       ,temp-var)))))
+		      data)))))))
+
+
+;;; If just one body form, then don't use progn.  This allows restart-case to
+;;; "see" calls to error, etc.
+;;;
 (defmacro with-simple-restart ((restart-name format-string
 					     &rest format-arguments)
 			       &body forms)
@@ -307,7 +392,7 @@ The previous version is uglier, but it sets up unique run-time tags.
    If restart-name is not invoked, then all values returned by forms are
    returned.  If control is transferred to this restart, it immediately
    returns the values nil and t."
-  `(restart-case (progn ,@forms)
+  `(restart-case ,(if (= (length forms) 1) (car forms) `(progn ,@forms))
      (,restart-name ()
         :report (lambda (stream)
 		  (format stream ,format-string ,@format-arguments))
@@ -932,26 +1017,26 @@ The previous version sets up unique run-time tags.
 ;;; ABORT signals an error in case there was a restart named abort that did
 ;;; not tranfer control dynamically.  This could happen with RESTART-BIND.
 ;;;
-(defun abort ()
+(defun abort (&optional condition)
   "Transfers control to a restart named abort, signalling a control-error if
    none exists."
-  (invoke-restart 'abort)
+  (invoke-restart (find-restart 'abort condition))
   (error 'abort-failure))
 
 
-(defun muffle-warning ()
+(defun muffle-warning (&optional condition)
   "Transfers control to a restart named muffle-warning, signalling a
    control-error if none exists."
-  (invoke-restart 'muffle-warning))
+  (invoke-restart (find-restart 'muffle-warning condition)))
 
 
 ;;; DEFINE-NIL-RETURNING-RESTART finds the restart before invoking it to keep
 ;;; INVOKE-RESTART from signalling a control-error condition.
 ;;;
 (defmacro define-nil-returning-restart (name args doc)
-  `(defun ,name ,args
+  `(defun ,name (,@args &optional condition)
      ,doc
-     (if (find-restart ',name) (invoke-restart ',name ,@args))))
+     (if (find-restart ',name condition) (invoke-restart ',name ,@args))))
 
 (define-nil-returning-restart continue ()
   "Transfer control to a restart named continue, returning nil if none exists.")