(defn pretty-writer [writer max-columns miser-width]
(let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))
fields (ref {:pretty-writer true
:base (column-writer writer max-columns)
:logical-blocks lb
:sections nil
:mode :writing
:buffer []
:buffer-block lb
:buffer-level 1
:miser-width miser-width
:trailing-white-space nil
:pos 0})]
(proxy [Writer IDeref] []
(deref [] fields)
(write
([x]
;; (prlabel write x (getf :mode))
(condp = (class x)
String
(let [^String s0 (write-initial-lines this x)
^String s (.replaceFirst s0 "\\s+$" "")
white-space (.substring s0 (count s))
mode (getf :mode)]
(dosync
(if (= mode :writing)
(do
(write-white-space this)
(.write (getf :base) s)
(setf :trailing-white-space white-space))
(let [oldpos (getf :pos)
newpos (+ oldpos (count s0))]
(setf :pos newpos)
(add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
Integer
(write-char this x)
Long
(write-char this x))))
(flush []
(if (= (getf :mode) :buffering)
(dosync
(write-tokens this (getf :buffer) true)
(setf :buffer []))
(write-white-space this)))
(close []
(.flush this)))))
Used in 0 other vars
Comments top
No comments for pretty-writer. Log in to add a comment.