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