From 51f6f3deb64ed2bc94917d427bce9806b626f368 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Thu, 7 Oct 2004 17:06:05 +0000
Subject: [PATCH] o Add a pprinter for HANDLER-BIND.  Use it to handle
 HANDLER-BIND and   HANDLER-CASE. o Add a pprinter for MULTIPLE-VALUE-BIND,
 instead of using the PROGV   printer.  Use it for WITH-CONDITION-RESTARTS,
 too.  (Is this right?)

---
 code/pprint.lisp | 20 +++++++++++++++-----
 1 file changed, 15 insertions(+), 5 deletions(-)

diff --git a/code/pprint.lisp b/code/pprint.lisp
index dff80a4a1..b9193c088 100644
--- a/code/pprint.lisp
+++ b/code/pprint.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.44 2004/10/05 22:01:41 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pprint.lisp,v 1.45 2004/10/07 17:06:05 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1302,6 +1302,16 @@
   (funcall (formatter "~:<~^~W~^~3I ~_~W~^ ~_~W~^~1I~@{ ~_~W~}~:>")
 	   stream list))
 
+(defun pprint-multiple-value-bind (stream list &rest noise)
+  (declare (ignore noise))
+  (funcall (formatter "~:<~^~W~^~5I ~:_~W~3I ~:@_~W~1I~@{ ~:@_~W~}~:>")
+	   stream list))
+
+(defun pprint-handler-bind (stream list &rest noise)
+  (declare (ignore noise))
+  (funcall (formatter "~:<~^~W~3I ~:_~W~1I~@{ ~:@_~W~}~:>")
+	   stream list))
+  
 (defun pprint-quote (stream list &rest noise)
   (declare (ignore noise))
   (if (and (consp list)
@@ -1499,10 +1509,10 @@
     (dotimes pprint-dolist)
     (ecase pprint-case)
     (etypecase pprint-typecase)
-    #+nil (handler-bind ...)
-    #+nil (handler-case ...)
+    (handler-bind pprint-handler-bind)
+    (handler-case pprint-handler-bind)
     #+nil (loop ...)
-    (multiple-value-bind pprint-progv)
+    (multiple-value-bind pprint-multiple-value-bind)
     (multiple-value-setq pprint-block)
     (pprint-logical-block pprint-block)
     (print-unreadable-object pprint-block)
@@ -1521,7 +1531,7 @@
     (unless pprint-block)
     (when pprint-block)
     (with-compilation-unit pprint-block)
-    #+nil (with-condition-restarts ...)
+    (with-condition-restarts pprint-multiple-value-bind)
     (with-hash-table-iterator pprint-block)
     (with-input-from-string pprint-block)
     (with-open-file pprint-block)
-- 
GitLab