Remove gen-class requirement from clojure.contrib.pprint. See #81

9 files changed, 239 insertions, 257 deletions

diff --git a/pom.xml b/pom.xml
index 7900ad1a..6444bd68 100644
--- a/pom.xml
+++ b/pom.xml
@@ -95,7 +95,6 @@
             <namespace>clojure\.contrib\.fnmap\.PersistentFnMap</namespace>
             <namespace>clojure\.contrib\.condition\.Condition</namespace>
             <namespace>clojure\.contrib\.repl-ln</namespace>
-            <namespace>clojure\.contrib\.pprint\.gen-class</namespace>
           </namespaces>
         </configuration>
         <executions>
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
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)