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