comparison src/clojure/contrib/pprint/column_writer.clj @ 10:ef7dbbd6452c

added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
comparison
equal deleted inserted replaced
9:35cf337adfcf 10:ef7dbbd6452c
1 ;;; column_writer.clj -- part of the pretty printer for Clojure
2
3 ;; by Tom Faulhaber
4 ;; April 3, 2009
5 ;; Revised to use proxy instead of gen-class April 2010
6
7 ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
8 ; The use and distribution terms for this software are covered by the
9 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
10 ; which can be found in the file epl-v10.html at the root of this distribution.
11 ; By using this software in any fashion, you are agreeing to be bound by
12 ; the terms of this license.
13 ; You must not remove this notice, or any other, from this software.
14
15 ;; This module implements a column-aware wrapper around an instance of java.io.Writer
16
17 (ns clojure.contrib.pprint.column-writer
18 (:import
19 [clojure.lang IDeref]
20 [java.io Writer]))
21
22 (def *default-page-width* 72)
23
24 (defn- get-field [^Writer this sym]
25 (sym @@this))
26
27 (defn- set-field [^Writer this sym new-val]
28 (alter @this assoc sym new-val))
29
30 (defn get-column [this]
31 (get-field this :cur))
32
33 (defn get-line [this]
34 (get-field this :line))
35
36 (defn get-max-column [this]
37 (get-field this :max))
38
39 (defn set-max-column [this new-max]
40 (dosync (set-field this :max new-max))
41 nil)
42
43 (defn get-writer [this]
44 (get-field this :base))
45
46 (defn- write-char [^Writer this ^Integer c]
47 (dosync (if (= c (int \newline))
48 (do
49 (set-field this :cur 0)
50 (set-field this :line (inc (get-field this :line))))
51 (set-field this :cur (inc (get-field this :cur)))))
52 (.write ^Writer (get-field this :base) c))
53
54 (defn column-writer
55 ([writer] (column-writer writer *default-page-width*))
56 ([writer max-columns]
57 (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})]
58 (proxy [Writer IDeref] []
59 (deref [] fields)
60 (write
61 ([^chars cbuf ^Integer off ^Integer len]
62 (let [^Writer writer (get-field this :base)]
63 (.write writer cbuf off len)))
64 ([x]
65 (condp = (class x)
66 String
67 (let [^String s x
68 nl (.lastIndexOf s (int \newline))]
69 (dosync (if (neg? nl)
70 (set-field this :cur (+ (get-field this :cur) (count s)))
71 (do
72 (set-field this :cur (- (count s) nl 1))
73 (set-field this :line (+ (get-field this :line)
74 (count (filter #(= % \newline) s)))))))
75 (.write ^Writer (get-field this :base) s))
76
77 Integer
78 (write-char this x)
79 Long
80 (write-char this x))))))))