From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 2 Dec 2011 11:18:00 +0000 (+0200)
Subject: define SB-EXT:PRINT-UNREADABLY as a function
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a00ea11a89c9db677e60edf6832c905a4527b5cb;p=sbcl.git

define SB-EXT:PRINT-UNREADABLY as a function

  So

    (handler-bind ((print-not-readable #'print-unreadably))
       ...)

  works.
---

diff --git a/NEWS b/NEWS
index 99a266b..5cea3b8 100644
--- a/NEWS
+++ b/NEWS
@@ -9,6 +9,9 @@ changes relative to sbcl-1.0.54:
        full-blows cross-compilation.)
   * enhancement: MAKE-ALIEN signals a storage-condition instead of returning a
     null alien when malloc() fails. (lp#891268)
+  * enhancement: SB-EXT:PRINT-UNREADABLY restart for PRINT-NOT-READABLE
+    conditions can be conveniently accessed through function with the same
+    name, analogously to CONTINUE.
   * optimization: the compiler is smarter about representation selection for
     floating point constants used in full calls.
   * bug fix: deadlock detection could report the same deadlock twice, for
diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 2015a77..05ac6e2 100644
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -1705,11 +1705,14 @@ the usual naming convention (names like *FOO*) for special variables"
   (define-nil-returning-restart continue ()
     "Transfer control to a restart named CONTINUE, or return NIL if none exists.")
   (define-nil-returning-restart store-value (value)
-    "Transfer control and VALUE to a restart named STORE-VALUE, or return NIL if
-   none exists.")
+    "Transfer control and VALUE to a restart named STORE-VALUE, or
+return NIL if none exists.")
   (define-nil-returning-restart use-value (value)
-    "Transfer control and VALUE to a restart named USE-VALUE, or return NIL if
-   none exists."))
+    "Transfer control and VALUE to a restart named USE-VALUE, or
+return NIL if none exists.")
+  (define-nil-returning-restart print-unreadably ()
+    "Transfer control to a restart named SB-EXT:PRINT-UNREADABLY, or
+return NIL if none exists."))
 
 ;;; single-stepping restarts
 
diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 54c8c9b..33f12aa 100644
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -574,4 +574,9 @@
 (with-test (:name :bug-867684)
   (assert (equal "ab" (format nil "a~0&b"))))
 
+(with-test (:name :print-unreadably-function)
+  (assert (equal "\"foo\""
+                 (handler-bind ((print-not-readable #'sb-ext:print-unreadably))
+                   (write-to-string (coerce "foo" 'base-string) :readably t)))))
+
 ;;; success