Mercurial > lasercutter

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