From f1d0746ba6a16f5b85e50e17599ca9ee0ddeb37f Mon Sep 17 00:00:00 2001
From: Andy Fingerhut <andy_fingerhut@alum.wustl.edu>
Date: Tue, 12 Feb 2013 14:49:01 -0800
Subject: [PATCH] CLJ-1073: Make print-sequential interruptible if
 *print-interruptibly* is true

---
 src/clj/clojure/core.clj       |  8 ++++++++
 src/clj/clojure/core_print.clj | 37 ++++++++++++++++++++++---------------
 src/jvm/clojure/lang/RT.java   |  1 +
 3 files changed, 31 insertions(+), 15 deletions(-)

diff --git a/src/clj/clojure/core.clj b/src/clj/clojure/core.clj
index f03c638..d6997e4 100644
--- a/src/clj/clojure/core.clj
+++ b/src/clj/clojure/core.clj
@@ -5906,6 +5906,14 @@
   "
   {:added "1.0"})
 
+(add-doc-and-meta *print-interruptibly*
+  "When set to logical true, (Thread/interrupted) will be checked
+  while printing sequential objects, and if true, printing will
+  immediately stop with an exception.
+
+  Defaults to false"
+  {:added "1.6"})
+
 (defn future?
   "Returns true if x is a future"
   {:added "1.1"
diff --git a/src/clj/clojure/core_print.clj b/src/clj/clojure/core_print.clj
index aa74a73..6700e77 100644
--- a/src/clj/clojure/core_print.clj
+++ b/src/clj/clojure/core_print.clj
@@ -44,21 +44,28 @@
       (do
         (.write w begin)
         (when-let [xs (seq sequence)]
-          (if (and (not *print-dup*) *print-length*)
-            (loop [[x & xs] xs
-                   print-length *print-length*]
-              (if (zero? print-length)
-                (.write w "...")
-                (do
-                  (print-one x w)
-                  (when xs
-                    (.write w sep)
-                    (recur xs (dec print-length))))))
-            (loop [[x & xs] xs]
-              (print-one x w)
-              (when xs
-                (.write w sep)
-                (recur xs)))))
+          (let [check-interrupted *print-interruptibly*]
+            (if (and (not *print-dup*) *print-length*)
+              (loop [[x & xs] xs
+                     print-length *print-length*]
+                (when (and check-interrupted (Thread/interrupted))
+                  (.flush w)
+                  (throw (java.io.InterruptedIOException.)))
+                (if (zero? print-length)
+                  (.write w "...")
+                  (do
+                    (print-one x w)
+                    (when xs
+                      (.write w sep)
+                      (recur xs (dec print-length))))))
+              (loop [[x & xs] xs]
+                (when (and check-interrupted (Thread/interrupted))
+                  (.flush w)
+                  (throw (java.io.InterruptedIOException.)))
+                (print-one x w)
+                (when xs
+                  (.write w sep)
+                  (recur xs))))))
         (.write w end)))))
 
 (defn- print-meta [o, ^Writer w]
diff --git a/src/jvm/clojure/lang/RT.java b/src/jvm/clojure/lang/RT.java
index 3349813..0fb1a25 100644
--- a/src/jvm/clojure/lang/RT.java
+++ b/src/jvm/clojure/lang/RT.java
@@ -222,6 +222,7 @@ final public static Var CURRENT_NS = Var.intern(CLOJURE_NS, Symbol.intern("*ns*"
 final static Var FLUSH_ON_NEWLINE = Var.intern(CLOJURE_NS, Symbol.intern("*flush-on-newline*"), T).setDynamic();
 final static Var PRINT_META = Var.intern(CLOJURE_NS, Symbol.intern("*print-meta*"), F).setDynamic();
 final static Var PRINT_READABLY = Var.intern(CLOJURE_NS, Symbol.intern("*print-readably*"), T).setDynamic();
+final static Var PRINT_INTERRUPTIBLY = Var.intern(CLOJURE_NS, Symbol.intern("*print-interruptibly*"), F).setDynamic();
 final static Var PRINT_DUP = Var.intern(CLOJURE_NS, Symbol.intern("*print-dup*"), F).setDynamic();
 final static Var WARN_ON_REFLECTION = Var.intern(CLOJURE_NS, Symbol.intern("*warn-on-reflection*"), F).setDynamic();
 final static Var ALLOW_UNRESOLVED_VARS = Var.intern(CLOJURE_NS, Symbol.intern("*allow-unresolved-vars*"), F).setDynamic();
-- 
1.8.0