Mercurial > lasercutter

     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))))))))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children