Move source files into Maven-style directory structure.

12 files changed, 0 insertions, 3731 deletions

diff --git a/src/clojure/contrib/pprint/ColumnWriter.clj b/src/clojure/contrib/pprint/ColumnWriter.clj
deleted file mode 100644
index fc6ae75c..00000000
--- a/src/clojure/contrib/pprint/ColumnWriter.clj
+++ /dev/null
@@ -1,89 +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
-  (:gen-class
-   :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))
-
-(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/clojure/contrib/pprint/PrettyWriter.clj b/src/clojure/contrib/pprint/PrettyWriter.clj
deleted file mode 100644
index 10192097..00000000
--- a/src/clojure/contrib/pprint/PrettyWriter.clj
+++ /dev/null
@@ -1,486 +0,0 @@
-;;; PrettyWriter.clj -- part of the pretty printer for Clojure
-
-;; by Tom Faulhaber
-;; April 3, 2009
-
-;   Copyright (c) Tom Faulhaber, Jan 2009. 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 wrapper around a java.io.Writer which implements the
-;; core of the XP algorithm.
-
-(ns clojure.contrib.pprint.PrettyWriter
-  (:refer-clojure :exclude (deftype))
-  (:use clojure.contrib.pprint.utilities)
-  (:gen-class
-   :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))
-
-;; TODO: Support for tab directives
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Macros to simplify dealing with types and classes. These are
-;;; really utilities, but I'm experimenting with them here.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro #^{:private true} 
-  getf 
-  "Get the value of the field a named by the argument (which should be a keyword)."
-  [sym]
-  `(~sym @(.pwstate ~'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))
-
-(defmacro deftype [type-name & fields]
-  (let [name-str (name type-name)]
-    `(do
-       (defstruct ~type-name :type-tag ~@fields)
-       (defn- ~(symbol (str "make-" name-str)) 
-         [& vals#] (apply struct ~type-name ~(keyword name-str) vals#))
-       (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; The data structures used by PrettyWriter
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defstruct #^{:private true} logical-block
-           :parent :section :start-col :indent
-           :done-nl :intra-block-nl
-           :prefix :per-line-prefix :suffix
-           :logical-block-callback)
-
-(defn ancestor? [parent child]
-  (loop [child (:parent child)]
-    (cond 
-     (nil? child) false
-     (identical? parent child) true
-     :else (recur (:parent child)))))
-
-(defstruct #^{:private true} section :parent)
-
-(defn buffer-length [l] 
-  (let [l (seq l)]
-    (if l 
-      (- (:end-pos (last l)) (:start-pos (first l)))
-      0)))
-
-; A blob of characters (aka a string)
-(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 end-block :logical-block :start-pos :end-pos)
-
-(deftype indent :logical-block :relative-to :offset :start-pos :end-pos)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Initialize the PrettyWriter instance
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(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}))])
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Functions to write tokens in the output buffer
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare emit-nl)
-
-(defmulti write-token #(:type-tag %2))
-(defmethod write-token :start-block [#^clojure.contrib.pprint.PrettyWriter 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)]
-       (ref-set (:start-col lb) col)
-       (ref-set (:indent lb) col)))))
-
-(defmethod write-token :end-block [#^clojure.contrib.pprint.PrettyWriter this token]
-  (when-let [cb (getf :logical-block-callback)] (cb :end))
-  (when-let [#^String suffix (:suffix (:logical-block token))] 
-    (.col_write this suffix)))
-
-(defmethod write-token :indent [#^clojure.contrib.pprint.PrettyWriter this token]
-  (let [lb (:logical-block token)]
-    (ref-set (:indent lb) 
-             (+ (:offset token)
-                (condp = (:relative-to token)
-		  :block @(:start-col lb)
-		  :current (.getColumn this))))))
-
-(defmethod write-token :buffer-blob [#^clojure.contrib.pprint.PrettyWriter this token]
-  (.col_write this #^String (:data token)))
-
-(defmethod write-token :nl [#^clojure.contrib.pprint.PrettyWriter this token]
-;  (prlabel wt @(:done-nl (:logical-block token)))
-;  (prlabel wt (:type token) (= (:type token) :mandatory))
-  (if (or (= (:type token) :mandatory)
-           (and (not (= (:type token) :fill))
-                @(:done-nl (:logical-block token))))
-    (emit-nl this token)
-    (if-let [#^String tws (getf :trailing-white-space)]
-      (.col_write this tws)))
-  (dosync (setf :trailing-white-space nil)))
-
-(defn- write-tokens [#^clojure.contrib.pprint.PrettyWriter this tokens force-trailing-whitespace]
-  (doseq [token tokens]
-    (if-not (= (:type-tag token) :nl)
-      (if-let [#^String tws (getf :trailing-white-space)]
-	(.col_write this 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)
-      (setf :trailing-white-space nil))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; emit-nl? method defs for each type of new line. This makes
-;;; the decision about whether to print this type of new line.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defn- tokens-fit? [#^clojure.contrib.pprint.PrettyWriter this tokens]
-;;;  (prlabel tf? (.getColumn this) (buffer-length tokens))
-  (let [maxcol (.getMaxColumn this)]
-    (or 
-     (nil? maxcol) 
-     (< (+ (.getColumn this) (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)]
-    (and miser-width maxcol
-         (>= @(:start-col lb) (- maxcol miser-width))
-         (linear-nl? this lb section))))
-
-(defmulti emit-nl? (fn [t _ _ _] (:type t)))
-
-(defmethod emit-nl? :linear [newl this section _]
-  (let [lb (:logical-block newl)]
-    (linear-nl? this lb section)))
-
-(defmethod emit-nl? :miser [newl this section _]
-  (let [lb (:logical-block newl)]
-    (miser-nl? this lb section)))
-
-(defmethod emit-nl? :fill [newl this section subsection]
-  (let [lb (:logical-block newl)]
-    (or @(:intra-block-nl lb)
-        (not (tokens-fit? this subsection))
-        (miser-nl? this lb section))))
-
-(defmethod emit-nl? :mandatory [_ _ _ _]
-  true)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Various support functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defn- get-section [buffer]
-  (let [nl (first buffer) 
-        lb (:logical-block nl)
-        section (seq (take-while #(not (and (nl? %) (ancestor? (:logical-block %) lb)))
-                                 (next buffer)))]
-    [section (seq (drop (inc (count section)) buffer))])) 
-
-(defn- get-sub-section [buffer]
-  (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)))))
-                            (next buffer)))]
-    section)) 
-
-(defn- update-nl-state [lb]
-  (dosync
-   (ref-set (:intra-block-nl lb) false)
-   (ref-set (:done-nl lb) true)
-   (loop [lb (:parent lb)]
-     (if lb
-       (do (ref-set (:done-nl lb) true)
-           (ref-set (:intra-block-nl lb) true)
-           (recur (:parent lb)))))))
-
-(defn emit-nl [#^clojure.contrib.pprint.PrettyWriter this nl]
-  (.col_write this (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))
-    (let [#^String istr (apply str (repeat (- @(:indent lb) (count prefix))
-					  \space))] 
-      (.col_write this istr))
-    (update-nl-state lb)))
-
-(defn- split-at-newline [tokens]
-  (let [pre (seq (take-while #(not (nl? %)) tokens))]
-    [pre (seq (drop (count pre) tokens))]))
-
-;;; Methods for showing token strings for debugging
-
-(defmulti tok :type-tag)
-(defmethod tok :nl [token]
-  (:type token))
-(defmethod tok :buffer-blob [token]
-  (str \" (:data token) (:trailing-white-space token) \"))
-(defmethod tok :default [token]
-  (:type-tag token))
-(defn toks [toks] (map tok toks))
-
-;;; write-token-string is called when the set of tokens in the buffer
-;;; is longer than the available space on the line
-
-(defn- write-token-string [this tokens]
-  (let [[a b] (split-at-newline tokens)]
-;;    (prlabel wts (toks a) (toks b))
-    (if a (write-tokens this a false))
-    (if b
-      (let [[section remainder] (get-section b)
-            newl (first b)]
-;;         (prlabel wts (toks section)) (prlabel wts (:type newl)) (prlabel wts (toks remainder)) 
-        (let [do-nl (emit-nl? newl this section (get-sub-section b))
-              result (if do-nl 
-                       (do
-;;                          (prlabel emit-nl (:type newl))
-                         (emit-nl this newl)
-                         (next b))
-                       b)
-              long-section (not (tokens-fit? this result))
-              result (if long-section
-                       (let [rem2 (write-token-string this section)]
-;;;                              (prlabel recurse (toks rem2))
-                         (if (= rem2 section)
-                           (do ; If that didn't produce any output, it has no nls
-                                        ; so we'll force it
-                             (write-tokens this section false)
-                             remainder)
-                           (into [] (concat rem2 remainder))))
-                       result)
-;;              ff (prlabel wts (toks result))
-              ] 
-          result)))))
-
-(defn- write-line [#^clojure.contrib.pprint.PrettyWriter this]
-  (dosync
-   (loop [buffer (getf :buffer)]
-;;     (prlabel wl1 (toks buffer))
-     (setf :buffer (into [] buffer))
-     (if (not (tokens-fit? this buffer))
-       (let [new-buffer (write-token-string this buffer)]
-;;          (prlabel wl new-buffer)
-         (if-not (identical? buffer new-buffer)
-                 (recur new-buffer)))))))
-
-;;; 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]
-;  (prlabel a2b token)
-  (dosync
-   (setf :buffer (conj (getf :buffer) token))
-   (if (not (tokens-fit? this (getf :buffer)))
-     (write-line this))))
-
-;;; Write all the tokens that have been buffered
-(defn- write-buffered-output [#^clojure.contrib.pprint.PrettyWriter this]
-  (write-line this)
-  (if-let [buf (getf :buffer)]
-    (do
-      (write-tokens this buf true)
-      (setf :buffer []))))
-
-;;; 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] 
-  (let [lines (.split s "\n" -1)]
-    (if (= (count lines) 1)
-      s
-      (dosync 
-       (let [#^String prefix (:per-line-prefix (first (getf :logical-blocks)))
-             #^String l (first lines)] 
-         (if (= :buffering (getf :mode))
-           (let [oldpos (getf :pos)
-                 newpos (+ oldpos (count l))]
-             (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))
-         (doseq [#^String l (next (butlast lines))]
-           (.col_write this l)
-           (.col_write this (int \newline))
-           (if prefix
-             (.col_write this prefix)))
-         (setf :buffering :writing)
-         (last lines))))))
-
-
-(defn write-white-space [#^clojure.contrib.pprint.PrettyWriter this]
-  (if-let [#^String tws (getf :trailing-white-space)]
-    (dosync
-     (.col_write this 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]
-  (if (= (getf :mode) :writing)
-    (do 
-      (write-white-space this)
-      (.col_write this c))
-    (if (= c \newline)
-      (write-initial-lines this "\n")
-      (let [oldpos (getf :pos)
-            newpos (inc oldpos)]
-        (dosync
-         (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?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Methods for PrettyWriter
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn -startBlock 
-  [#^clojure.contrib.pprint.PrettyWriter this 
-   #^String prefix #^String per-line-prefix #^String suffix]
-  (dosync 
-   (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0)
-                    (ref false) (ref false)
-                    prefix per-line-prefix suffix)]
-     (setf :logical-blocks lb)
-     (if (= (getf :mode) :writing)
-       (do
-         (write-white-space this)
-          (when-let [cb (getf :logical-block-callback)] (cb :start))
-          (if prefix 
-           (.col_write this prefix))
-         (let [col (.getColumn this)]
-           (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)))))))
-
-(defn -endBlock [#^clojure.contrib.pprint.PrettyWriter this]
-  (dosync
-   (let [lb (getf :logical-blocks)
-         #^String suffix (:suffix lb)]
-     (if (= (getf :mode) :writing)
-       (do
-         (write-white-space this)
-         (if suffix
-           (.col_write this 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))))
-     (setf :logical-blocks (:parent lb)))))
-
-(defn- -newline [#^clojure.contrib.pprint.PrettyWriter this type]
-  (dosync 
-   (setf :mode :buffering)
-   (let [pos (getf :pos)]
-     (add-to-buffer this (make-nl type (getf :logical-blocks) pos pos)))))
-
-(defn- -indent [#^clojure.contrib.pprint.PrettyWriter this relative-to offset]
-  (dosync 
-   (let [lb (getf :logical-blocks)]
-     (if (= (getf :mode) :writing)
-       (do
-         (write-white-space this)
-         (ref-set (:indent lb) 
-                  (+ offset (condp = relative-to
-			      :block @(:start-col lb)
-			      :current (.getColumn this)))))
-       (let [pos (getf :pos)]
-         (add-to-buffer this (make-indent lb relative-to offset pos pos)))))))
-
-(defn- -getMiserWidth [#^clojure.contrib.pprint.PrettyWriter this]
-  (getf :miser-width))
-
-(defn- -setMiserWidth [#^clojure.contrib.pprint.PrettyWriter this new-miser-width]
-  (dosync (setf :miser-width new-miser-width)))
-
-(defn- -setLogicalBlockCallback [#^clojure.contrib.pprint.PrettyWriter this f]
-  (dosync (setf :logical-block-callback f)))
diff --git a/src/clojure/contrib/pprint/cl_format.clj b/src/clojure/contrib/pprint/cl_format.clj
deleted file mode 100644
index 145697ff..00000000
--- a/src/clojure/contrib/pprint/cl_format.clj
+++ /dev/null
@@ -1,1843 +0,0 @@
-;;; cl_format.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 the Common Lisp compatible format function as documented
-;; in "Common Lisp the Language, 2nd edition", Chapter 22 (available online at:
-;; http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000)
-
-(in-ns 'clojure.contrib.pprint)
-
-;;; Forward references
-(declare compile-format)
-(declare execute-format)
-(declare init-navigator)
-;;; End forward references
-
-(defn cl-format 
-  "An implementation of a Common Lisp compatible format function. cl-format formats its
-arguments to an output stream or string based on the format control string given. It 
-supports sophisticated formatting of structured data.
-
-Writer is an instance of java.io.Writer, true to output to *out* or nil to output 
-to a string, format-in is the format control string and the remaining arguments 
-are the data to be formatted.
-
-The format control string is a string to be output with embedded 'format directives' 
-describing how to format the various arguments passed in.
-
-If writer is nil, cl-format returns the formatted result string. Otherwise, cl-format 
-returns nil.
-
-For example:
- (let [results [46 38 22]]
-        (cl-format true \"There ~[are~;is~:;are~]~:* ~d result~:p: ~{~d~^, ~}~%\" 
-                   (count results) results))
-
-Prints to *out*:
- There are 3 results: 46, 38, 22
-
-Detailed documentation on format control strings is available in the \"Common Lisp the 
-Language, 2nd edition\", Chapter 22 (available online at:
-http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000) 
-and in the Common Lisp HyperSpec at 
-http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm
-"
-  {:see-also [["http://www.cs.cmu.edu/afs/cs.cmu.edu/project/ai-repository/ai/html/cltl/clm/node200.html#SECTION002633000000000000000" 
-               "Common Lisp the Language"]
-              ["http://www.lispworks.com/documentation/HyperSpec/Body/22_c.htm"
-               "Common Lisp HyperSpec"]]}
-  [writer format-in & args]
-  (let [compiled-format (if (string? format-in) (compile-format format-in) format-in)
-        navigator (init-navigator args)]
-    (execute-format writer compiled-format navigator)))
-
-(def #^{:private true} *format-str* nil)
-
-(defn- format-error [message offset] 
-  (let [full-message (str message \newline *format-str* \newline 
-                           (apply str (repeat offset \space)) "^" \newline)]
-    (throw (RuntimeException. full-message))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Argument navigators manage the argument list
-;;; as the format statement moves through the list
-;;; (possibly going forwards and backwards as it does so)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defstruct #^{:private true}
-  arg-navigator :seq :rest :pos )
-
-(defn init-navigator 
-  "Create a new arg-navigator from the sequence with the position set to 0"
-  {:skip-wiki true}
-  [s]
-  (let [s (seq s)]
-    (struct arg-navigator s s 0)))
-
-;; TODO call format-error with offset
-(defn- next-arg [ navigator ]
-  (let [ rst (:rest navigator) ]
-    (if rst
-      [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
-     (throw (new Exception  "Not enough arguments for format definition")))))
-
-(defn- next-arg-or-nil [navigator]
-  (let [rst (:rest navigator)]
-    (if rst
-      [(first rst) (struct arg-navigator (:seq navigator ) (next rst) (inc (:pos navigator)))]
-      [nil navigator])))
-
-;; Get an argument off the arg list and compile it if it's not already compiled
-(defn- get-format-arg [navigator]
-  (let [[raw-format navigator] (next-arg navigator)
-        compiled-format (if (instance? String raw-format) 
-                               (compile-format raw-format)
-                               raw-format)]
-    [compiled-format navigator]))
-
-(declare relative-reposition)
-
-(defn- absolute-reposition [navigator position]
-  (if (>= position (:pos navigator))
-    (relative-reposition navigator (- (:pos navigator) position))
-    (struct arg-navigator (:seq navigator) (drop position (:seq navigator)) position)))
-
-(defn- relative-reposition [navigator position]
-  (let [newpos (+ (:pos navigator) position)]
-    (if (neg? position)
-      (absolute-reposition navigator newpos)
-      (struct arg-navigator (:seq navigator) (drop position (:rest navigator)) newpos))))
-
-(defstruct #^{:private true}
-  compiled-directive :func :def :params :offset)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; When looking at the parameter list, we may need to manipulate
-;;; the argument list as well (for 'V' and '#' parameter types).
-;;; We hide all of this behind a function, but clients need to
-;;; manage changing arg navigator
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; TODO: validate parameters when they come from arg list
-(defn- realize-parameter [[param [raw-val offset]] navigator]
-  (let [[real-param new-navigator]
-        (cond 
-         (contains? #{ :at :colon } param) ;pass flags through unchanged - this really isn't necessary
-         [raw-val navigator]
-
-         (= raw-val :parameter-from-args) 
-         (next-arg navigator)
-
-         (= raw-val :remaining-arg-count) 
-         [(count (:rest navigator)) navigator]
-
-         true 
-         [raw-val navigator])]
-    [[param [real-param offset]] new-navigator]))
-         
-(defn- realize-parameter-list [parameter-map navigator]
-  (let [[pairs new-navigator] 
-        (map-passing-context realize-parameter navigator parameter-map)]
-    [(into {} pairs) new-navigator]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Functions that support individual directives
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Common handling code for ~A and ~S
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare opt-base-str)
-
-(def #^{:private true}
-     special-radix-markers {2 "#b" 8 "#o", 16 "#x"})
-
-(defn- format-simple-number [n]
-  (cond 
-    (integer? n) (if (= *print-base* 10)
-                   (str n (if *print-radix* "."))
-                   (str
-                    (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
-                    (opt-base-str *print-base* n)))
-    (ratio? n) (str
-                (if *print-radix* (or (get special-radix-markers *print-base*) (str "#" *print-base* "r")))
-                (opt-base-str *print-base* (.numerator n))
-                "/"
-                (opt-base-str *print-base* (.denominator n)))
-    :else nil))
-
-(defn- format-ascii [print-func params arg-navigator offsets]
-  (let [ [arg arg-navigator] (next-arg arg-navigator) 
-         #^String base-output (or (format-simple-number arg) (print-func arg))
-         base-width (.length base-output)
-         min-width (+ base-width (:minpad params))
-         width (if (>= min-width (:mincol params)) 
-                 min-width
-                 (+ min-width 
-                    (* (+ (quot (- (:mincol params) min-width 1) 
-                                (:colinc params) )
-                          1)
-                       (:colinc params))))
-         chars (apply str (repeat (- width base-width) (:padchar params)))]
-    (if (:at params)
-      (print (str chars base-output))
-      (print (str base-output chars)))
-    arg-navigator))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Support for the integer directives ~D, ~X, ~O, ~B and some
-;;; of ~R
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- integral?
-  "returns true if a number is actually an integer (that is, has no fractional part)"
-  [x]
-  (cond
-   (integer? x) true
-   (decimal? x) (>= (.ulp (.stripTrailingZeros (bigdec 0))) 1) ; true iff no fractional part
-   (float? x)   (= x (Math/floor x))
-   (ratio? x)   (let [#^clojure.lang.Ratio r x]
-                  (= 0 (rem (.numerator r) (.denominator r))))
-   :else        false))
-
-(defn- remainders
-  "Return the list of remainders (essentially the 'digits') of val in the given base"
-  [base val]
-  (reverse 
-   (first 
-    (consume #(if (pos? %) 
-                [(rem % base) (quot % base)] 
-                [nil nil]) 
-             val))))
-
-;;; TODO: xlated-val does not seem to be used here.
-(defn- base-str
-  "Return val as a string in the given base"
-  [base val]
-  (if (zero? val)
-    "0"
-    (let [xlated-val (cond
-                       (float? val) (bigdec val)
-                       (ratio? val) (let [#^clojure.lang.Ratio r val] 
-                                      (/ (.numerator r) (.denominator r)))
-                       :else val)] 
-      (apply str 
-             (map 
-              #(if (< % 10) (char (+ (int \0) %)) (char (+ (int \a) (- % 10)))) 
-              (remainders base val))))))
-
-(def #^{:private true}
-     java-base-formats {8 "%o", 10 "%d", 16 "%x"})
-
-(defn- opt-base-str
-  "Return val as a string in the given base, using clojure.core/format if supported
-for improved performance"
-  [base val]
-  (let [format-str (get java-base-formats base)]
-    (if (and format-str (integer? val))
-      (clojure.core/format format-str val)
-      (base-str base val))))
-
-(defn- group-by [unit lis]
-  (reverse
-   (first
-    (consume (fn [x] [(seq (reverse (take unit x))) (seq (drop unit x))]) (reverse lis)))))
-
-(defn- format-integer [base params arg-navigator offsets]
-  (let [[arg arg-navigator] (next-arg arg-navigator)]
-    (if (integral? arg)
-      (let [neg (neg? arg)
-            pos-arg (if neg (- arg) arg)
-            raw-str (opt-base-str base pos-arg)
-            group-str (if (:colon params)
-                        (let [groups (map #(apply str %) (group-by (:commainterval params) raw-str))
-                              commas (repeat (count groups) (:commachar params))]
-                          (apply str (next (interleave commas groups))))
-                        raw-str)
-            #^String signed-str (cond
-                                  neg (str "-" group-str)
-                                  (:at params) (str "+" group-str)
-                                  true group-str)
-            padded-str (if (< (.length signed-str) (:mincol params))
-                         (str (apply str (repeat (- (:mincol params) (.length signed-str)) 
-                                                 (:padchar params)))
-                              signed-str)
-                         signed-str)]
-        (print padded-str))
-      (format-ascii print-str {:mincol (:mincol params) :colinc 1 :minpad 0 
-                               :padchar (:padchar params) :at true} 
-                    (init-navigator [arg]) nil))
-    arg-navigator))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Support for english formats (~R and ~:R)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def #^{:private true}
-     english-cardinal-units 
-     ["zero" "one" "two" "three" "four" "five" "six" "seven" "eight" "nine"
-      "ten" "eleven" "