diff --git a/pom.xml b/pom.xml
index 7900ad1a..6444bd68 100644
--- a/pom.xml
+++ b/pom.xml
@@ -95,7 +95,6 @@
clojure\.contrib\.fnmap\.PersistentFnMap
clojure\.contrib\.condition\.Condition
clojure\.contrib\.repl-ln
- clojure\.contrib\.pprint\.gen-class
diff --git a/src/main/clojure/clojure/contrib/pprint.clj b/src/main/clojure/clojure/contrib/pprint.clj
index 594cf4f3..e738792d 100644
--- a/src/main/clojure/clojure/contrib/pprint.clj
+++ b/src/main/clojure/clojure/contrib/pprint.clj
@@ -25,7 +25,8 @@ documentation on the the clojure-contrib web site on github.",
}
clojure.contrib.pprint
(:use clojure.contrib.pprint.utilities)
- (:import [clojure.contrib.pprint PrettyWriter]))
+ (:use clojure.contrib.pprint.pretty-writer
+ clojure.contrib.pprint.column-writer))
(load "pprint/pprint_base")
diff --git a/src/main/clojure/clojure/contrib/pprint/ColumnWriter.clj b/src/main/clojure/clojure/contrib/pprint/ColumnWriter.clj
deleted file mode 100644
index 99623da9..00000000
--- a/src/main/clojure/clojure/contrib/pprint/ColumnWriter.clj
+++ /dev/null
@@ -1,78 +0,0 @@
-;;; ColumnWriter.clj -- part of the pretty printer for Clojure
-
-;; by Tom Faulhaber
-;; April 3, 2009
-
-; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
-; The use and distribution terms for this software are covered by the
-; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
-; which can be found in the file epl-v10.html at the root of this distribution.
-; By using this software in any fashion, you are agreeing to be bound by
-; the terms of this license.
-; You must not remove this notice, or any other, from this software.
-
-;; This module implements a column-aware wrapper around an instance of java.io.Writer
-
-(ns clojure.contrib.pprint.ColumnWriter)
-
-(def *default-page-width* 72)
-
-(defn- -init
- ([writer] (-init writer *default-page-width*))
- ([writer max-columns] [[] (ref {:max max-columns, :cur 0, :line 0 :base writer})]))
-
-(defn- get-field [#^clojure.contrib.pprint.ColumnWriter this sym]
- (sym @(.state this)))
-
-(defn- set-field [#^clojure.contrib.pprint.ColumnWriter this sym new-val]
- (alter (.state this) assoc sym new-val))
-
-(defn- -getColumn [this]
- (get-field this :cur))
-
-(defn- -getLine [this]
- (get-field this :line))
-
-(defn- -getMaxColumn [this]
- (get-field this :max))
-
-(defn- -setMaxColumn [this new-max]
- (dosync (set-field this :max new-max))
- nil)
-
-(defn- -getWriter [this]
- (get-field this :base))
-
-(declare write-char)
-
-(defn- -write
- ([#^clojure.contrib.pprint.ColumnWriter this #^chars cbuf #^Integer off #^Integer len]
- (let [#^java.io.Writer writer (get-field this :base)]
- (.write writer cbuf off len)))
- ([#^clojure.contrib.pprint.ColumnWriter this x]
- (condp = (class x)
- String
- (let [#^String s x
- nl (.lastIndexOf s (int \newline))]
- (dosync (if (neg? nl)
- (set-field this :cur (+ (get-field this :cur) (count s)))
- (do
- (set-field this :cur (- (count s) nl 1))
- (set-field this :line (+ (get-field this :line)
- (count (filter #(= % \newline) s)))))))
- (.write #^java.io.Writer (get-field this :base) s))
-
- Integer
- (write-char this x))))
-
-(defn- write-char [#^clojure.contrib.pprint.ColumnWriter this #^Integer c]
- (dosync (if (= c (int \newline))
- (do
- (set-field this :cur 0)
- (set-field this :line (inc (get-field this :line))))
- (set-field this :cur (inc (get-field this :cur)))))
- (.write #^java.io.Writer (get-field this :base) c))
-
-(defn- -flush [this]) ;; Currently a no-op
-
-(defn- -close [this]) ;; Currently a no-op
diff --git a/src/main/clojure/clojure/contrib/pprint/cl_format.clj b/src/main/clojure/clojure/contrib/pprint/cl_format.clj
index 0488a079..58080e38 100644
--- a/src/main/clojure/clojure/contrib/pprint/cl_format.clj
+++ b/src/main/clojure/clojure/contrib/pprint/cl_format.clj
@@ -963,7 +963,7 @@ Note this should only be used for the last one in the sequence"
navigator (or new-navigator navigator)
min-remaining (or (first (:min-remaining else-params)) 0)
max-columns (or (first (:max-columns else-params))
- (.getMaxColumn #^PrettyWriter *out*))
+ (get-max-column *out*))
clauses (:clauses params)
[strs navigator] (render-clauses clauses navigator (:base-args params))
slots (max 1
@@ -981,7 +981,7 @@ Note this should only be used for the last one in the sequence"
pad (max minpad (quot total-pad slots))
extra-pad (- total-pad (* pad slots))
pad-str (apply str (repeat pad (:padchar params)))]
- (if (and eol-str (> (+ (.getColumn #^PrettyWriter *out*) min-remaining result-columns)
+ (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns)
max-columns))
(print eol-str))
(loop [slots slots
@@ -1139,10 +1139,10 @@ Note this should only be used for the last one in the sequence"
;;; If necessary, wrap the writer in a PrettyWriter object
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn pretty-writer [writer]
- (if (instance? PrettyWriter writer)
+(defn get-pretty-writer [writer]
+ (if (pretty-writer? writer)
writer
- (PrettyWriter. writer *print-right-margin* *print-miser-width*)))
+ (pretty-writer writer *print-right-margin* *print-miser-width*)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Support for column-aware operations ~&, ~T
@@ -1153,13 +1153,13 @@ Note this should only be used for the last one in the sequence"
"Make a newline if the Writer is not already at the beginning of the line.
N.B. Only works on ColumnWriters right now."
[]
- (if (not (= 0 (.getColumn #^PrettyWriter *out*)))
+ (if (not (= 0 (get-column (:base @@*out*))))
(prn)))
(defn- absolute-tabulation [params navigator offsets]
(let [colnum (:colnum params)
colinc (:colinc params)
- current (.getColumn #^PrettyWriter *out*)
+ current (get-column (:base @@*out*))
space-count (cond
(< current colnum) (- colnum current)
(= colinc 0) 0
@@ -1170,7 +1170,7 @@ N.B. Only works on ColumnWriters right now."
(defn- relative-tabulation [params navigator offsets]
(let [colrel (:colnum params)
colinc (:colinc params)
- start-col (+ colrel (.getColumn #^PrettyWriter *out*))
+ start-col (+ colrel (get-column (:base @@*out*)))
offset (if (pos? colinc) (rem start-col colinc) 0)
space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))]
(print (apply str (repeat space-count \space))))
@@ -1789,8 +1789,8 @@ because the formatter macro uses it."
(true? stream) *out*
:else stream)
#^java.io.Writer wrapped-stream (if (and (needs-pretty format)
- (not (instance? PrettyWriter real-stream)))
- (pretty-writer real-stream)
+ (not (pretty-writer? real-stream)))
+ (get-pretty-writer real-stream)
real-stream)]
(binding [*out* wrapped-stream]
(try
diff --git a/src/main/clojure/clojure/contrib/pprint/column_writer.clj b/src/main/clojure/clojure/contrib/pprint/column_writer.clj
new file mode 100644
index 00000000..65b94904
--- /dev/null
+++ b/src/main/clojure/clojure/contrib/pprint/column_writer.clj
@@ -0,0 +1,78 @@
+;;; column_writer.clj -- part of the pretty printer for Clojure
+
+;; by Tom Faulhaber
+;; April 3, 2009
+;; Revised to use proxy instead of gen-class April 2010
+
+; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
+; The use and distribution terms for this software are covered by the
+; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+; which can be found in the file epl-v10.html at the root of this distribution.
+; By using this software in any fashion, you are agreeing to be bound by
+; the terms of this license.
+; You must not remove this notice, or any other, from this software.
+
+;; This module implements a column-aware wrapper around an instance of java.io.Writer
+
+(ns clojure.contrib.pprint.column-writer
+ (:import
+ [clojure.lang IDeref]
+ [java.io Writer]))
+
+(def *default-page-width* 72)
+
+(defn- get-field [#^Writer this sym]
+ (sym @@this))
+
+(defn- set-field [#^Writer this sym new-val]
+ (alter @this assoc sym new-val))
+
+(defn get-column [this]
+ (get-field this :cur))
+
+(defn get-line [this]
+ (get-field this :line))
+
+(defn get-max-column [this]
+ (get-field this :max))
+
+(defn set-max-column [this new-max]
+ (dosync (set-field this :max new-max))
+ nil)
+
+(defn get-writer [this]
+ (get-field this :base))
+
+(defn- write-char [#^Writer this #^Integer c]
+ (dosync (if (= c (int \newline))
+ (do
+ (set-field this :cur 0)
+ (set-field this :line (inc (get-field this :line))))
+ (set-field this :cur (inc (get-field this :cur)))))
+ (.write #^Writer (get-field this :base) c))
+
+(defn column-writer
+ ([writer] (column-writer writer *default-page-width*))
+ ([writer max-columns]
+ (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})]
+ (proxy [Writer IDeref] []
+ (deref [] fields)
+ (write
+ ([#^chars cbuf #^Integer off #^Integer len]
+ (let [#^Writer writer (get-field this :base)]
+ (.write writer cbuf off len)))
+ ([x]
+ (condp = (class x)
+ String
+ (let [#^String s x
+ nl (.lastIndexOf s (int \newline))]
+ (dosync (if (neg? nl)
+ (set-field this :cur (+ (get-field this :cur) (count s)))
+ (do
+ (set-field this :cur (- (count s) nl 1))
+ (set-field this :line (+ (get-field this :line)
+ (count (filter #(= % \newline) s)))))))
+ (.write #^Writer (get-field this :base) s))
+
+ Integer
+ (write-char this x))))))))
diff --git a/src/main/clojure/clojure/contrib/pprint/gen_class.clj b/src/main/clojure/clojure/contrib/pprint/gen_class.clj
deleted file mode 100644
index 154476c9..00000000
--- a/src/main/clojure/clojure/contrib/pprint/gen_class.clj
+++ /dev/null
@@ -1,31 +0,0 @@
-;;; gen_class.clj: generate statically-named classes for pprint
-
-(ns clojure.contrib.pprint.gen-class)
-
-(gen-class :name clojure.contrib.pprint.ColumnWriter
- :impl-ns clojure.contrib.pprint.ColumnWriter
- :extends java.io.Writer
- :init init
- :constructors {[java.io.Writer Integer] [],
- [java.io.Writer] []}
- :methods [[getColumn [] Integer]
- [getLine [] Integer]
- [getMaxColumn [] Integer]
- [setMaxColumn [Integer] Void]
- [getWriter [] java.io.Writer]]
- :state state)
-
-(gen-class :name clojure.contrib.pprint.PrettyWriter
- :impl-ns clojure.contrib.pprint.PrettyWriter
- :extends clojure.contrib.pprint.ColumnWriter
- :init init
- :constructors {[java.io.Writer Integer Object] [java.io.Writer Integer]}
- :methods [[startBlock [String String String] void]
- [endBlock [] void]
- [newline [clojure.lang.Keyword] void]
- [indent [clojure.lang.Keyword Integer] void]
- [getMiserWidth [] Object]
- [setMiserWidth [Object] void]
- [setLogicalBlockCallback [clojure.lang.IFn] void]]
- :exposes-methods {write col_write}
- :state pwstate)
diff --git a/src/main/clojure/clojure/contrib/pprint/pprint_base.clj b/src/main/clojure/clojure/contrib/pprint/pprint_base.clj
index 064fc5ec..636b551a 100644
--- a/src/main/clojure/clojure/contrib/pprint/pprint_base.clj
+++ b/src/main/clojure/clojure/contrib/pprint/pprint_base.clj
@@ -140,12 +140,12 @@ radix specifier is in the form #XXr where XX is the decimal value of *print-base
(defn- pretty-writer?
"Return true iff x is a PrettyWriter"
- [x] (instance? PrettyWriter x))
+ [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x)))
(defn- make-pretty-writer
"Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width"
[base-writer right-margin miser-width]
- (PrettyWriter. base-writer right-margin miser-width))
+ (pretty-writer base-writer right-margin miser-width))
(defmacro #^{:private true} with-pretty-writer [base-writer & body]
`(let [base-writer# ~base-writer
@@ -235,7 +235,7 @@ print the object to the currently bound value of *out*."
(binding [*print-pretty* true]
(binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {})
(write-out object)))
- (if (not (= 0 (.getColumn #^PrettyWriter *out*)))
+ (if (not (= 0 (get-column *out*)))
(.write *out* (int \newline))))))
(defmacro pp
@@ -294,13 +294,13 @@ and :suffix."
[& args]
(let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)]
`(do (if (level-exceeded)
- (.write #^PrettyWriter *out* "#")
+ (.write #^java.io.Writer *out* "#")
(binding [*current-level* (inc *current-level*)
*current-length* 0]
- (.startBlock #^PrettyWriter *out*
+ (start-block *out*
~(:prefix options) ~(:per-line-prefix options) ~(:suffix options))
~@body
- (.endBlock #^PrettyWriter *out*)))
+ (end-block *out*)))
nil)))
(defn pprint-newline
@@ -310,7 +310,7 @@ newline is :linear, :miser, :fill, or :mandatory.
Output is sent to *out* which must be a pretty printing writer."
[kind]
(check-enumerated-arg kind #{:linear :miser :fill :mandatory})
- (.newline #^PrettyWriter *out* kind))
+ (nl *out* kind))
(defn pprint-indent
"Create an indent at this point in the pretty printing stream. This defines how
@@ -321,7 +321,7 @@ the current column position. n is an offset.
Output is sent to *out* which must be a pretty printing writer."
[relative-to n]
(check-enumerated-arg relative-to #{:block :current})
- (.indent #^PrettyWriter *out* relative-to n))
+ (indent *out* relative-to n))
;; TODO a real implementation for pprint-tab
(defn pprint-tab
diff --git a/src/main/clojure/clojure/contrib/pprint/PrettyWriter.clj b/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj
similarity index 68%
rename from src/main/clojure/clojure/contrib/pprint/PrettyWriter.clj
rename to src/main/clojure/clojure/contrib/pprint/pretty_writer.clj
index 04742696..ba9c78de 100644
--- a/src/main/clojure/clojure/contrib/pprint/PrettyWriter.clj
+++ b/src/main/clojure/clojure/contrib/pprint/pretty_writer.clj
@@ -1,7 +1,8 @@
-;;; PrettyWriter.clj -- part of the pretty printer for Clojure
+;;; pretty_writer.clj -- part of the pretty printer for Clojure
;; by Tom Faulhaber
;; April 3, 2009
+;; Revised to use proxy instead of gen-class April 2010
; Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved.
; The use and distribution terms for this software are covered by the
@@ -14,12 +15,24 @@
;; This module implements a wrapper around a java.io.Writer which implements the
;; core of the XP algorithm.
-(ns clojure.contrib.pprint.PrettyWriter
+(ns clojure.contrib.pprint.pretty-writer
(:refer-clojure :exclude (deftype))
- (:use clojure.contrib.pprint.utilities))
+ (:use clojure.contrib.pprint.utilities)
+ (:use [clojure.contrib.pprint.column-writer
+ :only (column-writer get-column get-max-column)])
+ (:import
+ [clojure.lang IDeref]
+ [java.io Writer]))
;; TODO: Support for tab directives
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Forward declarations
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare get-miser-width)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Macros to simplify dealing with types and classes. These are
;;; really utilities, but I'm experimenting with them here.
@@ -29,14 +42,15 @@
getf
"Get the value of the field a named by the argument (which should be a keyword)."
[sym]
- `(~sym @(.pwstate ~'this)))
+ `(~sym @@~'this))
(defmacro #^{:private true}
setf [sym new-val]
"Set the value of the field SYM to NEW-VAL"
- `(alter (.pwstate ~'this) assoc ~sym ~new-val))
+ `(alter @~'this assoc ~sym ~new-val))
-(defmacro deftype [type-name & fields]
+(defmacro #^{:private true}
+ deftype [type-name & fields]
(let [name-str (name type-name)]
`(do
(defstruct ~type-name :type-tag ~@fields)
@@ -45,7 +59,7 @@
(defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The data structures used by PrettyWriter
+;;; The data structures used by pretty-writer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defstruct #^{:private true} logical-block
@@ -73,31 +87,13 @@
(deftype buffer-blob :data :trailing-white-space :start-pos :end-pos)
; A newline
-(deftype nl :type :logical-block :start-pos :end-pos)
-
-(deftype start-block :logical-block :start-pos :end-pos)
+(deftype nl-t :type :logical-block :start-pos :end-pos)
-(deftype end-block :logical-block :start-pos :end-pos)
+(deftype start-block-t :logical-block :start-pos :end-pos)
-(deftype indent :logical-block :relative-to :offset :start-pos :end-pos)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Initialize the PrettyWriter instance
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(deftype end-block-t :logical-block :start-pos :end-pos)
-(defn- -init
- [writer max-columns miser-width]
- [[writer max-columns]
- (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))]
- (ref {:logical-blocks lb
- :sections nil
- :mode :writing
- :buffer []
- :buffer-block lb
- :buffer-level 1
- :miser-width miser-width
- :trailing-white-space nil
- :pos 0}))])
+(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Functions to write tokens in the output buffer
@@ -106,33 +102,33 @@
(declare emit-nl)
(defmulti write-token #(:type-tag %2))
-(defmethod write-token :start-block [#^clojure.contrib.pprint.PrettyWriter this token]
+(defmethod write-token :start-block-t [#^Writer this token]
(when-let [cb (getf :logical-block-callback)] (cb :start))
(let [lb (:logical-block token)]
(dosync
(when-let [#^String prefix (:prefix lb)]
- (.col_write this prefix))
- (let [col (.getColumn this)]
+ (.write (getf :base) prefix))
+ (let [col (get-column (getf :base))]
(ref-set (:start-col lb) col)
(ref-set (:indent lb) col)))))
-(defmethod write-token :end-block [#^clojure.contrib.pprint.PrettyWriter this token]
+(defmethod write-token :end-block-t [#^Writer this token]
(when-let [cb (getf :logical-block-callback)] (cb :end))
(when-let [#^String suffix (:suffix (:logical-block token))]
- (.col_write this suffix)))
+ (.write (getf :base) suffix)))
-(defmethod write-token :indent [#^clojure.contrib.pprint.PrettyWriter this token]
+(defmethod write-token :indent-t [#^Writer this token]
(let [lb (:logical-block token)]
(ref-set (:indent lb)
(+ (:offset token)
(condp = (:relative-to token)
:block @(:start-col lb)
- :current (.getColumn this))))))
+ :current (get-column (getf :base)))))))
-(defmethod write-token :buffer-blob [#^clojure.contrib.pprint.PrettyWriter this token]
- (.col_write this #^String (:data token)))
+(defmethod write-token :buffer-blob [#^Writer this token]
+ (.write (getf :base) #^String (:data token)))
-(defmethod write-token :nl [#^clojure.contrib.pprint.PrettyWriter this token]
+(defmethod write-token :nl-t [#^Writer this token]
; (prlabel wt @(:done-nl (:logical-block token)))
; (prlabel wt (:type token) (= (:type token) :mandatory))
(if (or (= (:type token) :mandatory)
@@ -140,19 +136,19 @@
@(:done-nl (:logical-block token))))
(emit-nl this token)
(if-let [#^String tws (getf :trailing-white-space)]
- (.col_write this tws)))
+ (.write (getf :base) tws)))
(dosync (setf :trailing-white-space nil)))
-(defn- write-tokens [#^clojure.contrib.pprint.PrettyWriter this tokens force-trailing-whitespace]
+(defn- write-tokens [#^Writer this tokens force-trailing-whitespace]
(doseq [token tokens]
- (if-not (= (:type-tag token) :nl)
+ (if-not (= (:type-tag token) :nl-t)
(if-let [#^String tws (getf :trailing-white-space)]
- (.col_write this tws)))
+ (.write (getf :base) tws)))
(write-token this token)
(setf :trailing-white-space (:trailing-white-space token)))
(let [#^String tws (getf :trailing-white-space)]
(when (and force-trailing-whitespace tws)
- (.col_write this tws)
+ (.write (getf :base) tws)
(setf :trailing-white-space nil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -161,21 +157,21 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn- tokens-fit? [#^clojure.contrib.pprint.PrettyWriter this tokens]
-;;; (prlabel tf? (.getColumn this) (buffer-length tokens))
- (let [maxcol (.getMaxColumn this)]
+(defn- tokens-fit? [#^Writer this tokens]
+;;; (prlabel tf? (get-column (getf :base) (buffer-length tokens))
+ (let [maxcol (get-max-column (getf :base))]
(or
(nil? maxcol)
- (< (+ (.getColumn this) (buffer-length tokens)) maxcol))))
+ (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol))))
(defn- linear-nl? [this lb section]
; (prlabel lnl? @(:done-nl lb) (tokens-fit? this section))
(or @(:done-nl lb)
(not (tokens-fit? this section))))
-(defn- miser-nl? [#^clojure.contrib.pprint.PrettyWriter this lb section]
- (let [miser-width (.getMiserWidth this)
- maxcol (.getMaxColumn this)]
+(defn- miser-nl? [#^Writer this lb section]
+ (let [miser-width (get-miser-width this)
+ maxcol (get-max-column (getf :base))]
(and miser-width maxcol
(>= @(:start-col lb) (- maxcol miser-width))
(linear-nl? this lb section))))
@@ -207,7 +203,7 @@
(defn- get-section [buffer]
(let [nl (first buffer)
lb (:logical-block nl)
- section (seq (take-while #(not (and (nl? %) (ancestor? (:logical-block %) lb)))
+ section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb)))
(next buffer)))]
[section (seq (drop (inc (count section)) buffer))]))
@@ -215,7 +211,7 @@
(let [nl (first buffer)
lb (:logical-block nl)
section (seq (take-while #(let [nl-lb (:logical-block %)]
- (not (and (nl? %) (or (= nl-lb lb) (ancestor? nl-lb lb)))))
+ (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb)))))
(next buffer)))]
section))
@@ -229,26 +225,26 @@
(ref-set (:intra-block-nl lb) true)
(recur (:parent lb)))))))
-(defn emit-nl [#^clojure.contrib.pprint.PrettyWriter this nl]
- (.col_write this (int \newline))
+(defn emit-nl [#^Writer this nl]
+ (.write (getf :base) (int \newline))
(dosync (setf :trailing-white-space nil))
(let [lb (:logical-block nl)
#^String prefix (:per-line-prefix lb)]
(if prefix
- (.col_write this prefix))
+ (.write (getf :base) prefix))
(let [#^String istr (apply str (repeat (- @(:indent lb) (count prefix))
\space))]
- (.col_write this istr))
+ (.write (getf :base) istr))
(update-nl-state lb)))
(defn- split-at-newline [tokens]
- (let [pre (seq (take-while #(not (nl? %)) tokens))]
+ (let [pre (seq (take-while #(not (nl-t? %)) tokens))]
[pre (seq (drop (count pre) tokens))]))
;;; Methods for showing token strings for debugging
(defmulti tok :type-tag)
-(defmethod tok :nl [token]
+(defmethod tok :nl-t [token]
(:type token))
(defmethod tok :buffer-blob [token]
(str \" (:data token) (:trailing-white-space token) \"))
@@ -289,7 +285,7 @@
]
result)))))
-(defn- write-line [#^clojure.contrib.pprint.PrettyWriter this]
+(defn- write-line [#^Writer this]
(dosync
(loop [buffer (getf :buffer)]
;; (prlabel wl1 (toks buffer))
@@ -302,7 +298,7 @@
;;; Add a buffer token to the buffer and see if it's time to start
;;; writing
-(defn- add-to-buffer [#^clojure.contrib.pprint.PrettyWriter this token]
+(defn- add-to-buffer [#^Writer this token]
; (prlabel a2b token)
(dosync
(setf :buffer (conj (getf :buffer) token))
@@ -310,7 +306,7 @@
(write-line this))))
;;; Write all the tokens that have been buffered
-(defn- write-buffered-output [#^clojure.contrib.pprint.PrettyWriter this]
+(defn- write-buffered-output [#^Writer this]
(write-line this)
(if-let [buf (getf :buffer)]
(do
@@ -320,7 +316,7 @@
;;; If there are newlines in the string, print the lines up until the last newline,
;;; making the appropriate adjustments. Return the remainder of the string
(defn- write-initial-lines
- [#^clojure.contrib.pprint.PrettyWriter this #^String s]
+ [#^Writer this #^String s]
(let [lines (.split s "\n" -1)]
(if (= (count lines) 1)
s
@@ -333,57 +329,28 @@
(setf :pos newpos)
(add-to-buffer this (make-buffer-blob l nil oldpos newpos))
(write-buffered-output this))
- (.col_write this l))
- (.col_write this (int \newline))
+ (.write (getf :base) l))
+ (.write (getf :base) (int \newline))
(doseq [#^String l (next (butlast lines))]
- (.col_write this l)
- (.col_write this (int \newline))
+ (.write (getf :base) l)
+ (.write (getf :base) (int \newline))
(if prefix
- (.col_write this prefix)))
+ (.write (getf :base) prefix)))
(setf :buffering :writing)
(last lines))))))
-(defn write-white-space [#^clojure.contrib.pprint.PrettyWriter this]
+(defn write-white-space [#^Writer this]
(if-let [#^String tws (getf :trailing-white-space)]
(dosync
- (.col_write this tws)
+ (.write (getf :base) tws)
(setf :trailing-white-space nil))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Writer overrides
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare write-char)
-
-(defn- -write
- ([#^clojure.contrib.pprint.PrettyWriter this x]
- ;; (prlabel write x (getf :mode))
- (condp = (class x)
- String
- (let [#^String s0 (write-initial-lines this x)
- #^String s (.replaceFirst s0 "\\s+$" "")
- white-space (.substring s0 (count s))
- mode (getf :mode)]
- (dosync
- (if (= mode :writing)
- (do
- (write-white-space this)
- (.col_write this s)
- (setf :trailing-white-space white-space))
- (let [oldpos (getf :pos)
- newpos (+ oldpos (count s0))]
- (setf :pos newpos)
- (add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
-
- Integer
- (write-char this x))))
-
-(defn- write-char [#^clojure.contrib.pprint.PrettyWriter this #^Integer c]
+(defn- write-char [#^Writer this #^Integer c]
(if (= (getf :mode) :writing)
(do
(write-white-space this)
- (.col_write this c))
+ (.write (getf :base) c))
(if (= c \newline)
(write-initial-lines this "\n")
(let [oldpos (getf :pos)
@@ -392,22 +359,68 @@
(setf :pos newpos)
(add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos)))))))
-(defn- -flush [#^clojure.contrib.pprint.PrettyWriter this]
- (if (= (getf :mode) :buffering)
- (dosync
- (write-tokens this (getf :buffer) true)
- (setf :buffer []))
- (write-white-space this)))
-(defn- -close [this]
- (-flush this)) ;TODO: close underlying stream?
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Initialize the pretty-writer instance
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(defn pretty-writer [writer max-columns miser-width]
+ (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))
+ fields (ref {:pretty-writer true
+ :base (column-writer writer max-columns)
+ :logical-blocks lb
+ :sections nil
+ :mode :writing
+ :buffer []
+ :buffer-block lb
+ :buffer-level 1
+ :miser-width miser-width
+ :trailing-white-space nil
+ :pos 0})]
+ (proxy [Writer IDeref] []
+ (deref [] fields)
+
+ (write
+ ([x]
+ ;; (prlabel write x (getf :mode))
+ (condp = (class x)
+ String
+ (let [#^String s0 (write-initial-lines this x)
+ #^String s (.replaceFirst s0 "\\s+$" "")
+ white-space (.substring s0 (count s))
+ mode (getf :mode)]
+ (dosync
+ (if (= mode :writing)
+ (do
+ (write-white-space this)
+ (.write (getf :base) s)
+ (setf :trailing-white-space white-space))
+ (let [oldpos (getf :pos)
+ newpos (+ oldpos (count s0))]
+ (setf :pos newpos)
+ (add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
+
+ Integer
+ (write-char this x))))
+
+ (flush []
+ (if (= (getf :mode) :buffering)
+ (dosync
+ (write-tokens this (getf :buffer) true)
+ (setf :buffer []))
+ (write-white-space this)))
+
+ (close []
+ (.flush this)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Methods for PrettyWriter
+;;; Methods for pretty-writer
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn -startBlock
- [#^clojure.contrib.pprint.PrettyWriter this
+(defn start-block
+ [#^Writer this
#^String prefix #^String per-line-prefix #^String suffix]
(dosync
(let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0)
@@ -419,16 +432,16 @@
(write-white-space this)
(when-let [cb (getf :logical-block-callback)] (cb :start))
(if prefix
- (.col_write this prefix))
- (let [col (.getColumn this)]
+ (.write (getf :base) prefix))
+ (let [col (get-column (getf :base))]
(ref-set (:start-col lb) col)
(ref-set (:indent lb) col)))
(let [oldpos (getf :pos)
newpos (+ oldpos (if prefix (count prefix) 0))]
(setf :pos newpos)
- (add-to-buffer this (make-start-block lb oldpos newpos)))))))
+ (add-to-buffer this (make-start-block-t lb oldpos newpos)))))))
-(defn -endBlock [#^clojure.contrib.pprint.PrettyWriter this]
+(defn end-block [#^Writer this]
(dosync
(let [lb (getf :logical-blocks)
#^String suffix (:suffix lb)]
@@ -436,21 +449,21 @@
(do
(write-white-space this)
(if suffix
- (.col_write this suffix))
+ (.write (getf :base) suffix))
(when-let [cb (getf :logical-block-callback)] (cb :end)))
(let [oldpos (getf :pos)
newpos (+ oldpos (if suffix (count suffix) 0))]
(setf :pos newpos)
- (add-to-buffer this (make-end-block lb oldpos newpos))))
+ (add-to-buffer this (make-end-block-t lb oldpos newpos))))
(setf :logical-blocks (:parent lb)))))
-(defn- -newline [#^clojure.contrib.pprint.PrettyWriter this type]
+(defn nl [#^Writer this type]
(dosync
(setf :mode :buffering)
(let [pos (getf :pos)]
- (add-to-buffer this (make-nl type (getf :logical-blocks) pos pos)))))
+ (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos)))))
-(defn- -indent [#^clojure.contrib.pprint.PrettyWriter this relative-to offset]
+(defn indent [#^Writer this relative-to offset]
(dosync
(let [lb (getf :logical-blocks)]
(if (= (getf :mode) :writing)
@@ -459,15 +472,15 @@
(ref-set (:indent lb)
(+ offset (condp = relative-to
:block @(:start-col lb)
- :current (.getColumn this)))))
+ :current (get-column (getf :base))))))
(let [pos (getf :pos)]
- (add-to-buffer this (make-indent lb relative-to offset pos pos)))))))
+ (add-to-buffer this (make-indent-t lb relative-to offset pos pos)))))))
-(defn- -getMiserWidth [#^clojure.contrib.pprint.PrettyWriter this]
+(defn get-miser-width [#^Writer this]
(getf :miser-width))
-(defn- -setMiserWidth [#^clojure.contrib.pprint.PrettyWriter this new-miser-width]
+(defn set-miser-width [#^Writer this new-miser-width]
(dosync (setf :miser-width new-miser-width)))
-(defn- -setLogicalBlockCallback [#^clojure.contrib.pprint.PrettyWriter this f]
+(defn set-logical-block-callback [#^Writer this f]
(dosync (setf :logical-block-callback f)))
diff --git a/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj b/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj
index ae9ce914..c1c997fd 100644
--- a/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj
+++ b/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj
@@ -445,14 +445,14 @@
(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s"))))
(defn list-to-table [aseq column-width]
- (let [stream (pretty-writer (java.io.StringWriter.))]
+ (let [stream (get-pretty-writer (java.io.StringWriter.))]
(binding [*out* stream]
(doseq [row aseq]
(doseq [col row]
(cl-format true "~4D~7,vT" col column-width))
(prn)))
(.flush stream)
- (.toString (.getWriter stream))))
+ (.toString (:base @@(:base @@stream)))))
(simple-tests column-writer-test
(list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8)