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