1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/pprint/column_writer.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,80 @@
     1.4 +;;; column_writer.clj -- part of the pretty printer for Clojure
     1.5 +
     1.6 +;; by Tom Faulhaber
     1.7 +;; April 3, 2009
     1.8 +;; Revised to use proxy instead of gen-class April 2010
     1.9 +
    1.10 +;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
    1.11 +;   The use and distribution terms for this software are covered by the
    1.12 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
    1.13 +;   which can be found in the file epl-v10.html at the root of this distribution.
    1.14 +;   By using this software in any fashion, you are agreeing to be bound by
    1.15 +;   the terms of this license.
    1.16 +;   You must not remove this notice, or any other, from this software.
    1.17 +
    1.18 +;; This module implements a column-aware wrapper around an instance of java.io.Writer
    1.19 +
    1.20 +(ns clojure.contrib.pprint.column-writer
    1.21 +  (:import
    1.22 +   [clojure.lang IDeref]
    1.23 +   [java.io Writer]))
    1.24 +
    1.25 +(def *default-page-width* 72)
    1.26 +
    1.27 +(defn- get-field [^Writer this sym]
    1.28 +  (sym @@this))
    1.29 +
    1.30 +(defn- set-field [^Writer this sym new-val] 
    1.31 +  (alter @this assoc sym new-val))
    1.32 +
    1.33 +(defn get-column [this]
    1.34 +  (get-field this :cur))
    1.35 +
    1.36 +(defn get-line [this]
    1.37 +  (get-field this :line))
    1.38 +
    1.39 +(defn get-max-column [this]
    1.40 +  (get-field this :max))
    1.41 +
    1.42 +(defn set-max-column [this new-max]
    1.43 +  (dosync (set-field this :max new-max))
    1.44 +  nil)
    1.45 +
    1.46 +(defn get-writer [this]
    1.47 +  (get-field this :base))
    1.48 +
    1.49 +(defn- write-char [^Writer this ^Integer c]
    1.50 +  (dosync (if (= c (int \newline))
    1.51 +	    (do
    1.52 +              (set-field this :cur 0)
    1.53 +              (set-field this :line (inc (get-field this :line))))
    1.54 +	    (set-field this :cur (inc (get-field this :cur)))))
    1.55 +  (.write ^Writer (get-field this :base) c))
    1.56 +
    1.57 +(defn column-writer   
    1.58 +  ([writer] (column-writer writer *default-page-width*))
    1.59 +  ([writer max-columns]
    1.60 +     (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})]
    1.61 +       (proxy [Writer IDeref] []
    1.62 +         (deref [] fields)
    1.63 +         (write
    1.64 +          ([^chars cbuf ^Integer off ^Integer len] 
    1.65 +             (let [^Writer writer (get-field this :base)] 
    1.66 +               (.write writer cbuf off len)))
    1.67 +          ([x]
    1.68 +             (condp = (class x)
    1.69 +               String 
    1.70 +               (let [^String s x
    1.71 +                     nl (.lastIndexOf s (int \newline))]
    1.72 +                 (dosync (if (neg? nl)
    1.73 +                           (set-field this :cur (+ (get-field this :cur) (count s)))
    1.74 +                           (do
    1.75 +                             (set-field this :cur (- (count s) nl 1))
    1.76 +                             (set-field this :line (+ (get-field this :line)
    1.77 +                                                      (count (filter #(= % \newline) s)))))))
    1.78 +                 (.write ^Writer (get-field this :base) s))
    1.79 +
    1.80 +               Integer
    1.81 +               (write-char this x)
    1.82 +               Long
    1.83 +               (write-char this x))))))))