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