prettyprint: allow with-short-limits and without-limits to override defaults.

This is based on a patch by @hiljusti.

diff --git a/basis/prettyprint/config/config.factor b/basis/prettyprint/config/config.factor
index ed18ee71dccee307e7438a364adee3ceb78963b7..f80781b4d01323553a128bc9bc1a701ac61d4fa0 100644 (file)
--- a/basis/prettyprint/config/config.factor
+++ b/basis/prettyprint/config/config.factor
@@ -13,6 +13,7 @@ SYMBOL: number-base
 SYMBOL: string-limit?
 SYMBOL: boa-tuples?
 SYMBOL: c-object-pointers?
+SYMBOL: has-limits?
 
 4 tab-size set-global
 64 margin set-global
@@ -20,8 +21,9 @@ SYMBOL: c-object-pointers?
 100 length-limit set-global
 10 number-base set-global
 t string-limit? set-global
+f has-limits? set-global
 
-: with-short-limits ( quot -- )
+: (with-short-limits) ( quot -- )
     H{
         { line-limit 1 }
         { length-limit 15 }
@@ -29,13 +31,21 @@ t string-limit? set-global
         { string-limit? t }
         { boa-tuples? t }
         { c-object-pointers? f }
+        { has-limits? t }
     } clone swap with-variables ; inline
 
-: without-limits ( quot -- )
+: with-short-limits ( quot -- )
+    has-limits? get [ call ] [ (with-short-limits) ] if ; inline
+
+: (without-limits) ( quot -- )
     H{
         { nesting-limit f }
         { length-limit f }
         { line-limit f }
         { string-limit? f }
         { c-object-pointers? f }
+        { has-limits? t }
     } clone swap with-variables ; inline
+
+: without-limits ( quot -- )
+    has-limits? get [ call ] [ (without-limits) ] if ; inline

diff --git a/basis/prettyprint/prettyprint-tests.factor b/basis/prettyprint/prettyprint-tests.factor
index e1f0477105596aa53ef40f74bd8c6bb0802e4820..c7a597104cc13aa0a15edab6f349a9bafd8b7337 100644 (file)
--- a/basis/prettyprint/prettyprint-tests.factor
+++ b/basis/prettyprint/prettyprint-tests.factor
@@ -384,6 +384,10 @@ TUPLE: final-tuple ; final
 
 { "{ ~array~ }\n" } [ [ { { 1 2 } } short. ] with-string-writer ] unit-test
 
+{ "{ { 1 2 } }\n" } [ [ [ { { 1 2 } } short. ] without-limits ] with-string-writer ] unit-test
+
+{ "{ ~array~ }\n" } [ [ [ { { 1 2 } } . ] with-short-limits ] with-string-writer ] unit-test
+
 { "H{ { 1 { 2 3 } } }\n" } [
     f nesting-limit [
         [ H{ { 1 { 2 3 } } } . ] with-string-writer