summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/clj/clojure/pprint.clj3
-rw-r--r--src/clj/clojure/pprint/dispatch.clj15
-rw-r--r--src/clj/clojure/pprint/pprint_base.clj29
-rw-r--r--test/clojure/test_clojure/pprint/test_pretty.clj51
4 files changed, 90 insertions, 8 deletions
diff --git a/src/clj/clojure/pprint.clj b/src/clj/clojure/pprint.clj
index 846a5f32..ba90aa65 100644
--- a/src/clj/clojure/pprint.clj
+++ b/src/clj/clojure/pprint.clj
@@ -35,7 +35,8 @@ See documentation for pprint and cl-format for more information or
complete documentation on the the clojure web site on github.",
:added "1.2"}
clojure.pprint
- (:refer-clojure :exclude (deftype)))
+ (:refer-clojure :exclude (deftype))
+ (:use [clojure.walk :only [walk]]))
(load "pprint/utilities")
diff --git a/src/clj/clojure/pprint/dispatch.clj b/src/clj/clojure/pprint/dispatch.clj
index a6ae2931..19ba9836 100644
--- a/src/clj/clojure/pprint/dispatch.clj
+++ b/src/clj/clojure/pprint/dispatch.clj
@@ -65,7 +65,7 @@
;;; (def pprint-simple-list (formatter-out "~:<~@{~w~^ ~_~}~:>"))
(defn- pprint-simple-list [alis]
(pprint-logical-block :prefix "(" :suffix ")"
- (loop [alis (seq alis)]
+ (print-length-loop [alis (seq alis)]
(when alis
(write-out (first alis))
(when (next alis)
@@ -80,7 +80,7 @@
;;; (def pprint-vector (formatter-out "~<[~;~@{~w~^ ~_~}~;]~:>"))
(defn- pprint-vector [avec]
(pprint-logical-block :prefix "[" :suffix "]"
- (loop [aseq (seq avec)]
+ (print-length-loop [aseq (seq avec)]
(when aseq
(write-out (first aseq))
(when (next aseq)
@@ -93,12 +93,13 @@
;;; (def pprint-map (formatter-out "~<{~;~@{~<~w~^ ~_~w~:>~^, ~_~}~;}~:>"))
(defn- pprint-map [amap]
(pprint-logical-block :prefix "{" :suffix "}"
- (loop [aseq (seq amap)]
+ (print-length-loop [aseq (seq amap)]
(when aseq
(pprint-logical-block
(write-out (ffirst aseq))
(.write ^java.io.Writer *out* " ")
(pprint-newline :linear)
+ (set! *current-length* 0) ; always print both parts of the [k v] pair
(write-out (fnext (first aseq))))
(when (next aseq)
(.write ^java.io.Writer *out* ", ")
@@ -218,7 +219,7 @@
(defn- pprint-binding-form [binding-vec]
(pprint-logical-block :prefix "[" :suffix "]"
- (loop [binding binding-vec]
+ (print-length-loop [binding binding-vec]
(when (seq binding)
(pprint-logical-block binding
(write-out (first binding))
@@ -255,7 +256,7 @@
(when (next alis)
(.write ^java.io.Writer *out* " ")
(pprint-newline :linear)
- (loop [alis (next alis)]
+ (print-length-loop [alis (next alis)]
(when alis
(pprint-logical-block alis
(write-out (first alis))
@@ -273,7 +274,7 @@
(pprint-logical-block :prefix "(" :suffix ")"
(pprint-indent :block 1)
(apply (formatter-out "~w ~@_~w ~@_~w ~_") alis)
- (loop [alis (seq (drop 3 alis))]
+ (print-length-loop [alis (seq (drop 3 alis))]
(when alis
(pprint-logical-block alis
(write-out (first alis))
@@ -315,7 +316,7 @@
(defn- pprint-simple-code-list [alis]
(pprint-logical-block :prefix "(" :suffix ")"
(pprint-indent :block 1)
- (loop [alis (seq alis)]
+ (print-length-loop [alis (seq alis)]
(when alis
(write-out (first alis))
(when (next alis)
diff --git a/src/clj/clojure/pprint/pprint_base.clj b/src/clj/clojure/pprint/pprint_base.clj
index 4be9ac51..ea035d42 100644
--- a/src/clj/clojure/pprint/pprint_base.clj
+++ b/src/clj/clojure/pprint/pprint_base.clj
@@ -371,4 +371,33 @@ THIS FUNCTION IS NOT YET IMPLEMENTED."
(throw (UnsupportedOperationException. "pprint-tab is not yet implemented")))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Helpers for dispatch function writing
+;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- pll-mod-body [var-sym body]
+ (letfn [(inner [form]
+ (if (seq? form)
+ (let [form (macroexpand form)]
+ (condp = (first form)
+ 'loop* form
+ 'recur (concat `(recur (inc ~var-sym)) (rest form))
+ (walk inner identity form)))
+ form))]
+ (walk inner identity body)))
+
+(defmacro print-length-loop
+ "A version of loop that iterates at most *print-length* times. This is designed
+for use in pretty-printer dispatch functions."
+ {:added "1.3"}
+ [bindings & body]
+ (let [count-var (gensym "length-count")
+ mod-body (pll-mod-body count-var body)]
+ `(loop ~(apply vector count-var 0 bindings)
+ (if (or (not *print-length*) (< ~count-var *print-length*))
+ (do ~@mod-body)
+ (.write ^java.io.Writer *out* "...")))))
+
nil
diff --git a/test/clojure/test_clojure/pprint/test_pretty.clj b/test/clojure/test_clojure/pprint/test_pretty.clj
index ebbb29a1..77af6c52 100644
--- a/test/clojure/test_clojure/pprint/test_pretty.clj
+++ b/test/clojure/test_clojure/pprint/test_pretty.clj
@@ -272,4 +272,55 @@ Usage: *hello*
"[\"hello\" \"there\"]\n"
)
+(simple-tests print-length-tests
+ (binding [*print-length* 1] (with-out-str (pprint '(a b c d e f))))
+ "(a ...)\n"
+ (binding [*print-length* 2] (with-out-str (pprint '(a b c d e f))))
+ "(a b ...)\n"
+ (binding [*print-length* 6] (with-out-str (pprint '(a b c d e f))))
+ "(a b c d e f)\n"
+ (binding [*print-length* 8] (with-out-str (pprint '(a b c d e f))))
+ "(a b c d e f)\n"
+
+ (binding [*print-length* 1] (with-out-str (pprint [1 2 3 4 5 6])))
+ "[1 ...]\n"
+ (binding [*print-length* 2] (with-out-str (pprint [1 2 3 4 5 6])))
+ "[1 2 ...]\n"
+ (binding [*print-length* 6] (with-out-str (pprint [1 2 3 4 5 6])))
+ "[1 2 3 4 5 6]\n"
+ (binding [*print-length* 8] (with-out-str (pprint [1 2 3 4 5 6])))
+ "[1 2 3 4 5 6]\n"
+
+ ;; This set of tests isn't that great cause it assumes that the set remains
+ ;; ordered for printing. This is currently (1.3) true, but no future
+ ;; guarantees
+ (binding [*print-length* 1] (with-out-str (pprint #{1 2 3 4 5 6})))
+ "#{1 ...}\n"
+ (binding [*print-length* 2] (with-out-str (pprint #{1 2 3 4 5 6})))
+ "#{1 2 ...}\n"
+ (binding [*print-length* 6] (with-out-str (pprint #{1 2 3 4 5 6})))
+ "#{1 2 3 4 5 6}\n"
+ (binding [*print-length* 8] (with-out-str (pprint #{1 2 3 4 5 6})))
+ "#{1 2 3 4 5 6}\n"
+
+ ;; See above comment and apply to this map :)
+ (binding [*print-length* 1] (with-out-str (pprint {1 2, 3 4, 5 6, 7 8, 9 10, 11 12})))
+ "{1 2, ...}\n"
+ (binding [*print-length* 2] (with-out-str (pprint {1 2, 3 4, 5 6, 7 8, 9 10, 11 12})))
+ "{1 2, 3 4, ...}\n"
+ (binding [*print-length* 6] (with-out-str (pprint {1 2, 3 4, 5 6, 7 8, 9 10, 11 12})))
+ "{1 2, 3 4, 5 6, 7 8, 9 10, 11 12}\n"
+ (binding [*print-length* 8] (with-out-str (pprint {1 2, 3 4, 5 6, 7 8, 9 10, 11 12})))
+ "{1 2, 3 4, 5 6, 7 8, 9 10, 11 12}\n"
+
+
+ (binding [*print-length* 1] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
+ "[1, ...]\n"
+ (binding [*print-length* 2] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
+ "[1, 2, ...]\n"
+ (binding [*print-length* 6] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
+ "[1, 2, 3, 4, 5, 6]\n"
+ (binding [*print-length* 8] (with-out-str (pprint (int-array [1 2 3 4 5 6]))))
+ "[1, 2, 3, 4, 5, 6]\n"
+ )
generated by cgit v1.2.3-18-g5258 (git 2.32.0) at 2025-07-07 12:27:10 +0000