Mercurial > lasercutter
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)))))))) |