Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Remove gen-class requirement from clojure.contrib.pprint. See #81

  • Loading branch information...
commit 661dcfde7965c3e6650d169afca4a20ef146c940 1 parent 78ee9b3
Tom Faulhaber authored April 29, 2010
1  pom.xml
@@ -95,7 +95,6 @@
95 95
             <namespace>clojure\.contrib\.fnmap\.PersistentFnMap</namespace>
96 96
             <namespace>clojure\.contrib\.condition\.Condition</namespace>
97 97
             <namespace>clojure\.contrib\.repl-ln</namespace>
98  
-            <namespace>clojure\.contrib\.pprint\.gen-class</namespace>
99 98
           </namespaces>
100 99
         </configuration>
101 100
         <executions>
3  src/main/clojure/clojure/contrib/pprint.clj
@@ -25,7 +25,8 @@ documentation on the the clojure-contrib web site on github.",
25 25
        }
26 26
     clojure.contrib.pprint
27 27
   (:use clojure.contrib.pprint.utilities)
28  
-  (:import [clojure.contrib.pprint PrettyWriter]))
  28
+  (:use clojure.contrib.pprint.pretty-writer
  29
+        clojure.contrib.pprint.column-writer))
29 30
 
30 31
 
31 32
 (load "pprint/pprint_base")
78  src/main/clojure/clojure/contrib/pprint/ColumnWriter.clj
... ...
@@ -1,78 +0,0 @@
1  
-;;; ColumnWriter.clj -- part of the pretty printer for Clojure
2  
-
3  
-;; by Tom Faulhaber
4  
-;; April 3, 2009
5  
-
6  
-;   Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved.
7  
-;   The use and distribution terms for this software are covered by the
8  
-;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
9  
-;   which can be found in the file epl-v10.html at the root of this distribution.
10  
-;   By using this software in any fashion, you are agreeing to be bound by
11  
-;   the terms of this license.
12  
-;   You must not remove this notice, or any other, from this software.
13  
-
14  
-;; This module implements a column-aware wrapper around an instance of java.io.Writer
15  
-
16  
-(ns clojure.contrib.pprint.ColumnWriter)
17  
-
18  
-(def *default-page-width* 72)
19  
-
20  
-(defn- -init 
21  
-  ([writer] (-init writer *default-page-width*))
22  
-  ([writer max-columns] [[] (ref {:max max-columns, :cur 0, :line 0 :base writer})]))
23  
-
24  
-(defn- get-field [#^clojure.contrib.pprint.ColumnWriter this sym]
25  
-  (sym @(.state this)))
26  
-
27  
-(defn- set-field [#^clojure.contrib.pprint.ColumnWriter this sym new-val] 
28  
-  (alter (.state this) assoc sym new-val))
29  
-
30  
-(defn- -getColumn [this]
31  
-  (get-field this :cur))
32  
-
33  
-(defn- -getLine [this]
34  
-  (get-field this :line))
35  
-
36  
-(defn- -getMaxColumn [this]
37  
-  (get-field this :max))
38  
-
39  
-(defn- -setMaxColumn [this new-max]
40  
-  (dosync (set-field this :max new-max))
41  
-  nil)
42  
-
43  
-(defn- -getWriter [this]
44  
-  (get-field this :base))
45  
-
46  
-(declare write-char)
47  
-
48  
-(defn- -write 
49  
-  ([#^clojure.contrib.pprint.ColumnWriter this #^chars cbuf #^Integer off #^Integer len] 
50  
-     (let [#^java.io.Writer writer (get-field this :base)] 
51  
-       (.write writer cbuf off len)))
52  
-  ([#^clojure.contrib.pprint.ColumnWriter this x]
53  
-     (condp = (class x)
54  
-       String 
55  
-       (let [#^String s x
56  
-	     nl (.lastIndexOf s (int \newline))]
57  
-	 (dosync (if (neg? nl)
58  
-		   (set-field this :cur (+ (get-field this :cur) (count s)))
59  
-		   (do
60  
-                     (set-field this :cur (- (count s) nl 1))
61  
-                     (set-field this :line (+ (get-field this :line)
62  
-                                              (count (filter #(= % \newline) s)))))))
63  
-	 (.write #^java.io.Writer (get-field this :base) s))
64  
-
65  
-       Integer
66  
-       (write-char this x))))
67  
-
68  
-(defn- write-char [#^clojure.contrib.pprint.ColumnWriter this #^Integer c]
69  
-  (dosync (if (= c (int \newline))
70  
-	    (do
71  
-              (set-field this :cur 0)
72  
-              (set-field this :line (inc (get-field this :line))))
73  
-	    (set-field this :cur (inc (get-field this :cur)))))
74  
-  (.write #^java.io.Writer (get-field this :base) c))
75  
-
76  
-(defn- -flush [this]) ;; Currently a no-op
77  
-
78  
-(defn- -close [this]) ;; Currently a no-op
20  src/main/clojure/clojure/contrib/pprint/cl_format.clj
@@ -963,7 +963,7 @@ Note this should only be used for the last one in the sequence"
963 963
         navigator (or new-navigator navigator)
964 964
         min-remaining (or (first (:min-remaining else-params)) 0)
965 965
         max-columns (or (first (:max-columns else-params))
966  
-                        (.getMaxColumn #^PrettyWriter *out*))
  966
+                        (get-max-column *out*))
967 967
         clauses (:clauses params)
968 968
         [strs navigator] (render-clauses clauses navigator (:base-args params))
969 969
         slots (max 1
@@ -981,7 +981,7 @@ Note this should only be used for the last one in the sequence"
981 981
         pad (max minpad (quot total-pad slots))
982 982
         extra-pad (- total-pad (* pad slots))
983 983
         pad-str (apply str (repeat pad (:padchar params)))]
984  
-    (if (and eol-str (> (+ (.getColumn #^PrettyWriter *out*) min-remaining result-columns) 
  984
+    (if (and eol-str (> (+ (get-column (:base @@*out*)) min-remaining result-columns) 
985 985
                         max-columns))
986 986
       (print eol-str))
987 987
     (loop [slots slots
@@ -1139,10 +1139,10 @@ Note this should only be used for the last one in the sequence"
1139 1139
 ;;; If necessary, wrap the writer in a PrettyWriter object
1140 1140
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1141 1141
 
1142  
-(defn pretty-writer [writer]
1143  
-  (if (instance? PrettyWriter writer) 
  1142
+(defn get-pretty-writer [writer]
  1143
+  (if (pretty-writer? writer) 
1144 1144
     writer
1145  
-    (PrettyWriter. writer *print-right-margin* *print-miser-width*)))
  1145
+    (pretty-writer writer *print-right-margin* *print-miser-width*)))
1146 1146
  
1147 1147
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1148 1148
 ;;; Support for column-aware operations ~&, ~T
@@ -1153,13 +1153,13 @@ Note this should only be used for the last one in the sequence"
1153 1153
   "Make a newline if the Writer is not already at the beginning of the line.
1154 1154
 N.B. Only works on ColumnWriters right now."
1155 1155
   []
1156  
-  (if (not (= 0 (.getColumn #^PrettyWriter *out*)))
  1156
+  (if (not (= 0 (get-column (:base @@*out*))))
1157 1157
     (prn)))
1158 1158
 
1159 1159
 (defn- absolute-tabulation [params navigator offsets]
1160 1160
   (let [colnum (:colnum params) 
1161 1161
         colinc (:colinc params)
1162  
-        current (.getColumn #^PrettyWriter *out*)
  1162
+        current (get-column (:base @@*out*))
1163 1163
         space-count (cond
1164 1164
                      (< current colnum) (- colnum current)
1165 1165
                      (= colinc 0) 0
@@ -1170,7 +1170,7 @@ N.B. Only works on ColumnWriters right now."
1170 1170
 (defn- relative-tabulation [params navigator offsets]
1171 1171
   (let [colrel (:colnum params) 
1172 1172
         colinc (:colinc params)
1173  
-        start-col (+ colrel (.getColumn #^PrettyWriter *out*))
  1173
+        start-col (+ colrel (get-column (:base @@*out*)))
1174 1174
         offset (if (pos? colinc) (rem start-col colinc) 0)
1175 1175
         space-count (+ colrel (if (= 0 offset) 0 (- colinc offset)))]
1176 1176
     (print (apply str (repeat space-count \space))))
@@ -1789,8 +1789,8 @@ because the formatter macro uses it."
1789 1789
                                          (true? stream) *out*
1790 1790
                                          :else stream)
1791 1791
            #^java.io.Writer wrapped-stream (if (and (needs-pretty format) 
1792  
-                                                    (not (instance? PrettyWriter real-stream)))
1793  
-                                             (pretty-writer real-stream)
  1792
+                                                    (not (pretty-writer? real-stream)))
  1793
+                                             (get-pretty-writer real-stream)
1794 1794
                                              real-stream)]
1795 1795
        (binding [*out* wrapped-stream]
1796 1796
          (try
78  src/main/clojure/clojure/contrib/pprint/column_writer.clj
... ...
@@ -0,0 +1,78 @@
  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))))))))
31  src/main/clojure/clojure/contrib/pprint/gen_class.clj
... ...
@@ -1,31 +0,0 @@
1  
-;;; gen_class.clj: generate statically-named classes for pprint
2  
-
3  
-(ns clojure.contrib.pprint.gen-class)
4  
-
5  
-(gen-class :name clojure.contrib.pprint.ColumnWriter
6  
-           :impl-ns clojure.contrib.pprint.ColumnWriter
7  
-           :extends java.io.Writer
8  
-           :init init
9  
-           :constructors {[java.io.Writer Integer] [], 
10  
-                          [java.io.Writer] []}
11  
-           :methods [[getColumn [] Integer]
12  
-                     [getLine [] Integer]
13  
-                     [getMaxColumn [] Integer]
14  
-                     [setMaxColumn [Integer] Void]
15  
-                     [getWriter [] java.io.Writer]]
16  
-           :state state)
17  
-
18  
-(gen-class :name clojure.contrib.pprint.PrettyWriter
19  
-           :impl-ns clojure.contrib.pprint.PrettyWriter
20  
-           :extends clojure.contrib.pprint.ColumnWriter
21  
-           :init init
22  
-           :constructors {[java.io.Writer Integer Object] [java.io.Writer Integer]}
23  
-           :methods [[startBlock [String String String] void]
24  
-                     [endBlock [] void]
25  
-                     [newline [clojure.lang.Keyword] void]
26  
-                     [indent [clojure.lang.Keyword Integer] void]
27  
-                     [getMiserWidth [] Object]
28  
-                     [setMiserWidth [Object] void]
29  
-                     [setLogicalBlockCallback [clojure.lang.IFn] void]]
30  
-           :exposes-methods {write col_write}
31  
-           :state pwstate)
16  src/main/clojure/clojure/contrib/pprint/pprint_base.clj
@@ -140,12 +140,12 @@ radix specifier is in the form #XXr where XX is the decimal value of *print-base
140 140
 
141 141
 (defn- pretty-writer? 
142 142
   "Return true iff x is a PrettyWriter"
143  
-  [x] (instance? PrettyWriter x))
  143
+  [x] (and (instance? clojure.lang.IDeref x) (:pretty-writer @@x)))
144 144
 
145 145
 (defn- make-pretty-writer 
146 146
   "Wrap base-writer in a PrettyWriter with the specified right-margin and miser-width"
147 147
   [base-writer right-margin miser-width]
148  
-  (PrettyWriter. base-writer right-margin miser-width))
  148
+  (pretty-writer base-writer right-margin miser-width))
149 149
 
150 150
 (defmacro #^{:private true} with-pretty-writer [base-writer & body]
151 151
   `(let [base-writer# ~base-writer
@@ -235,7 +235,7 @@ print the object to the currently bound value of *out*."
235 235
        (binding [*print-pretty* true]
236 236
          (binding-map (if (or (not (= *print-base* 10)) *print-radix*) {#'pr pr-with-base} {}) 
237 237
            (write-out object)))
238  
-       (if (not (= 0 (.getColumn #^PrettyWriter *out*)))
  238
+       (if (not (= 0 (get-column *out*)))
239 239
          (.write *out* (int \newline))))))
240 240
 
241 241
 (defmacro pp 
@@ -294,13 +294,13 @@ and :suffix."
294 294
   [& args]
295 295
   (let [[options body] (parse-lb-options #{:prefix :per-line-prefix :suffix} args)]
296 296
     `(do (if (level-exceeded) 
297  
-           (.write #^PrettyWriter *out* "#")
  297
+           (.write #^java.io.Writer *out* "#")
298 298
            (binding [*current-level* (inc *current-level*)
299 299
                      *current-length* 0] 
300  
-             (.startBlock #^PrettyWriter *out*
  300
+             (start-block *out*
301 301
                           ~(:prefix options) ~(:per-line-prefix options) ~(:suffix options))
302 302
              ~@body
303  
-             (.endBlock #^PrettyWriter *out*)))
  303
+             (end-block *out*)))
304 304
          nil)))
305 305
 
306 306
 (defn pprint-newline
@@ -310,7 +310,7 @@ newline is :linear, :miser, :fill, or :mandatory.
310 310
 Output is sent to *out* which must be a pretty printing writer."
311 311
   [kind] 
312 312
   (check-enumerated-arg kind #{:linear :miser :fill :mandatory})
313  
-  (.newline #^PrettyWriter *out* kind))
  313
+  (nl *out* kind))
314 314
 
315 315
 (defn pprint-indent 
316 316
   "Create an indent at this point in the pretty printing stream. This defines how 
@@ -321,7 +321,7 @@ the current column position. n is an offset.
321 321
 Output is sent to *out* which must be a pretty printing writer."
322 322
   [relative-to n] 
323 323
   (check-enumerated-arg relative-to #{:block :current})
324  
-  (.indent #^PrettyWriter *out* relative-to n))
  324
+  (indent *out* relative-to n))
325 325
 
326 326
 ;; TODO a real implementation for pprint-tab
327 327
 (defn pprint-tab 
265  ...n/clojure/clojure/contrib/pprint/PrettyWriter.clj → .../clojure/clojure/contrib/pprint/pretty_writer.clj
... ...
@@ -1,7 +1,8 @@
1  
-;;; PrettyWriter.clj -- part of the pretty printer for Clojure
  1
+;;; pretty_writer.clj -- part of the pretty printer for Clojure
2 2
 
3 3
 ;; by Tom Faulhaber
4 4
 ;; April 3, 2009
  5
+;; Revised to use proxy instead of gen-class April 2010
5 6
 
6 7
 ;   Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved.
7 8
 ;   The use and distribution terms for this software are covered by the
@@ -14,12 +15,24 @@
14 15
 ;; This module implements a wrapper around a java.io.Writer which implements the
15 16
 ;; core of the XP algorithm.
16 17
 
17  
-(ns clojure.contrib.pprint.PrettyWriter
  18
+(ns clojure.contrib.pprint.pretty-writer
18 19
   (:refer-clojure :exclude (deftype))
19  
-  (:use clojure.contrib.pprint.utilities))
  20
+  (:use clojure.contrib.pprint.utilities)
  21
+  (:use [clojure.contrib.pprint.column-writer
  22
+         :only (column-writer get-column get-max-column)])
  23
+  (:import
  24
+   [clojure.lang IDeref]
  25
+   [java.io Writer]))
20 26
 
21 27
 ;; TODO: Support for tab directives
22 28
 
  29
+
  30
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31
+;;; Forward declarations
  32
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33
+
  34
+(declare get-miser-width)
  35
+
23 36
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
24 37
 ;;; Macros to simplify dealing with types and classes. These are
25 38
 ;;; really utilities, but I'm experimenting with them here.
@@ -29,14 +42,15 @@
29 42
   getf 
30 43
   "Get the value of the field a named by the argument (which should be a keyword)."
31 44
   [sym]
32  
-  `(~sym @(.pwstate ~'this)))
  45
+  `(~sym @@~'this))
33 46
 
34 47
 (defmacro #^{:private true} 
35 48
   setf [sym new-val] 
36 49
   "Set the value of the field SYM to NEW-VAL"
37  
-  `(alter (.pwstate ~'this) assoc ~sym ~new-val))
  50
+  `(alter @~'this assoc ~sym ~new-val))
38 51
 
39  
-(defmacro deftype [type-name & fields]
  52
+(defmacro #^{:private true} 
  53
+  deftype [type-name & fields]
40 54
   (let [name-str (name type-name)]
41 55
     `(do
42 56
        (defstruct ~type-name :type-tag ~@fields)
@@ -45,7 +59,7 @@
45 59
        (defn- ~(symbol (str name-str "?")) [x#] (= (:type-tag x#) ~(keyword name-str))))))
46 60
 
47 61
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48  
-;;; The data structures used by PrettyWriter
  62
+;;; The data structures used by pretty-writer
49 63
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
50 64
 
51 65
 (defstruct #^{:private true} logical-block
@@ -73,31 +87,13 @@
73 87
 (deftype buffer-blob :data :trailing-white-space :start-pos :end-pos)
74 88
 
75 89
 ; A newline
76  
-(deftype nl :type :logical-block :start-pos :end-pos)
77  
-
78  
-(deftype start-block :logical-block :start-pos :end-pos)
  90
+(deftype nl-t :type :logical-block :start-pos :end-pos)
79 91
 
80  
-(deftype end-block :logical-block :start-pos :end-pos)
  92
+(deftype start-block-t :logical-block :start-pos :end-pos)
81 93
 
82  
-(deftype indent :logical-block :relative-to :offset :start-pos :end-pos)
83  
-
84  
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
85  
-;;; Initialize the PrettyWriter instance
86  
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  94
+(deftype end-block-t :logical-block :start-pos :end-pos)
87 95
 
88  
-(defn- -init 
89  
-  [writer max-columns miser-width]
90  
-  [[writer max-columns] 
91  
-   (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))]
92  
-     (ref {:logical-blocks lb 
93  
-           :sections nil
94  
-           :mode :writing
95  
-           :buffer []
96  
-           :buffer-block lb
97  
-           :buffer-level 1
98  
-           :miser-width miser-width
99  
-           :trailing-white-space nil
100  
-           :pos 0}))])
  96
+(deftype indent-t :logical-block :relative-to :offset :start-pos :end-pos)
101 97
 
102 98
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
103 99
 ;;; Functions to write tokens in the output buffer
@@ -106,33 +102,33 @@
106 102
 (declare emit-nl)
107 103
 
108 104
 (defmulti write-token #(:type-tag %2))
109  
-(defmethod write-token :start-block [#^clojure.contrib.pprint.PrettyWriter this token]
  105
+(defmethod write-token :start-block-t [#^Writer this token]
110 106
    (when-let [cb (getf :logical-block-callback)] (cb :start))
111 107
    (let [lb (:logical-block token)]
112 108
     (dosync
113 109
      (when-let [#^String prefix (:prefix lb)] 
114  
-       (.col_write this prefix))
115  
-     (let [col (.getColumn this)]
  110
+       (.write (getf :base) prefix))
  111
+     (let [col (get-column (getf :base))]
116 112
        (ref-set (:start-col lb) col)
117 113
        (ref-set (:indent lb) col)))))
118 114
 
119  
-(defmethod write-token :end-block [#^clojure.contrib.pprint.PrettyWriter this token]
  115
+(defmethod write-token :end-block-t [#^Writer this token]
120 116
   (when-let [cb (getf :logical-block-callback)] (cb :end))
121 117
   (when-let [#^String suffix (:suffix (:logical-block token))] 
122  
-    (.col_write this suffix)))
  118
+    (.write (getf :base) suffix)))
123 119
 
124  
-(defmethod write-token :indent [#^clojure.contrib.pprint.PrettyWriter this token]
  120
+(defmethod write-token :indent-t [#^Writer this token]
125 121
   (let [lb (:logical-block token)]
126 122
     (ref-set (:indent lb) 
127 123
              (+ (:offset token)
128 124
                 (condp = (:relative-to token)
129 125
 		  :block @(:start-col lb)
130  
-		  :current (.getColumn this))))))
  126
+		  :current (get-column (getf :base)))))))
131 127
 
132  
-(defmethod write-token :buffer-blob [#^clojure.contrib.pprint.PrettyWriter this token]
133  
-  (.col_write this #^String (:data token)))
  128
+(defmethod write-token :buffer-blob [#^Writer this token]
  129
+  (.write (getf :base) #^String (:data token)))
134 130
 
135  
-(defmethod write-token :nl [#^clojure.contrib.pprint.PrettyWriter this token]
  131
+(defmethod write-token :nl-t [#^Writer this token]
136 132
 ;  (prlabel wt @(:done-nl (:logical-block token)))
137 133
 ;  (prlabel wt (:type token) (= (:type token) :mandatory))
138 134
   (if (or (= (:type token) :mandatory)
@@ -140,19 +136,19 @@
140 136
                 @(:done-nl (:logical-block token))))
141 137
     (emit-nl this token)
142 138
     (if-let [#^String tws (getf :trailing-white-space)]
143  
-      (.col_write this tws)))
  139
+      (.write (getf :base) tws)))
144 140
   (dosync (setf :trailing-white-space nil)))
145 141
 
146  
-(defn- write-tokens [#^clojure.contrib.pprint.PrettyWriter this tokens force-trailing-whitespace]
  142
+(defn- write-tokens [#^Writer this tokens force-trailing-whitespace]
147 143
   (doseq [token tokens]
148  
-    (if-not (= (:type-tag token) :nl)
  144
+    (if-not (= (:type-tag token) :nl-t)
149 145
       (if-let [#^String tws (getf :trailing-white-space)]
150  
-	(.col_write this tws)))
  146
+	(.write (getf :base) tws)))
151 147
     (write-token this token)
152 148
     (setf :trailing-white-space (:trailing-white-space token)))
153 149
   (let [#^String tws (getf :trailing-white-space)] 
154 150
     (when (and force-trailing-whitespace tws)
155  
-      (.col_write this tws)
  151
+      (.write (getf :base) tws)
156 152
       (setf :trailing-white-space nil))))
157 153
 
158 154
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -161,21 +157,21 @@
161 157
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
162 158
 
163 159
 
164  
-(defn- tokens-fit? [#^clojure.contrib.pprint.PrettyWriter this tokens]
165  
-;;;  (prlabel tf? (.getColumn this) (buffer-length tokens))
166  
-  (let [maxcol (.getMaxColumn this)]
  160
+(defn- tokens-fit? [#^Writer this tokens]
  161
+;;;  (prlabel tf? (get-column (getf :base) (buffer-length tokens))
  162
+  (let [maxcol (get-max-column (getf :base))]
167 163
     (or 
168 164
      (nil? maxcol) 
169  
-     (< (+ (.getColumn this) (buffer-length tokens)) maxcol))))
  165
+     (< (+ (get-column (getf :base)) (buffer-length tokens)) maxcol))))
170 166
 
171 167
 (defn- linear-nl? [this lb section]
172 168
 ;  (prlabel lnl? @(:done-nl lb) (tokens-fit? this section))
173 169
   (or @(:done-nl lb)
174 170
       (not (tokens-fit? this section))))
175 171
 
176  
-(defn- miser-nl? [#^clojure.contrib.pprint.PrettyWriter this lb section]
177  
-  (let [miser-width (.getMiserWidth this)
178  
-        maxcol (.getMaxColumn this)]
  172
+(defn- miser-nl? [#^Writer this lb section]
  173
+  (let [miser-width (get-miser-width this)
  174
+        maxcol (get-max-column (getf :base))]
179 175
     (and miser-width maxcol
180 176
          (>= @(:start-col lb) (- maxcol miser-width))
181 177
          (linear-nl? this lb section))))
@@ -207,7 +203,7 @@
207 203
 (defn- get-section [buffer]
208 204
   (let [nl (first buffer) 
209 205
         lb (:logical-block nl)
210  
-        section (seq (take-while #(not (and (nl? %) (ancestor? (:logical-block %) lb)))
  206
+        section (seq (take-while #(not (and (nl-t? %) (ancestor? (:logical-block %) lb)))
211 207
                                  (next buffer)))]
212 208
     [section (seq (drop (inc (count section)) buffer))])) 
213 209
 
@@ -215,7 +211,7 @@
215 211
   (let [nl (first buffer) 
216 212
         lb (:logical-block nl)
217 213
         section (seq (take-while #(let [nl-lb (:logical-block %)]
218  
-                                    (not (and (nl? %) (or (= nl-lb lb) (ancestor? nl-lb lb)))))
  214
+                                    (not (and (nl-t? %) (or (= nl-lb lb) (ancestor? nl-lb lb)))))
219 215
                             (next buffer)))]
220 216
     section)) 
221 217
 
@@ -229,26 +225,26 @@
229 225
            (ref-set (:intra-block-nl lb) true)
230 226
            (recur (:parent lb)))))))
231 227
 
232  
-(defn emit-nl [#^clojure.contrib.pprint.PrettyWriter this nl]
233  
-  (.col_write this (int \newline))
  228
+(defn emit-nl [#^Writer this nl]
  229
+  (.write (getf :base) (int \newline))
234 230
   (dosync (setf :trailing-white-space nil))
235 231
   (let [lb (:logical-block nl)
236 232
         #^String prefix (:per-line-prefix lb)] 
237 233
     (if prefix 
238  
-      (.col_write this prefix))
  234
+      (.write (getf :base) prefix))
239 235
     (let [#^String istr (apply str (repeat (- @(:indent lb) (count prefix))
240 236
 					  \space))] 
241  
-      (.col_write this istr))
  237
+      (.write (getf :base) istr))
242 238
     (update-nl-state lb)))
243 239
 
244 240
 (defn- split-at-newline [tokens]
245  
-  (let [pre (seq (take-while #(not (nl? %)) tokens))]
  241
+  (let [pre (seq (take-while #(not (nl-t? %)) tokens))]
246 242
     [pre (seq (drop (count pre) tokens))]))
247 243
 
248 244
 ;;; Methods for showing token strings for debugging
249 245
 
250 246
 (defmulti tok :type-tag)
251  
-(defmethod tok :nl [token]
  247
+(defmethod tok :nl-t [token]
252 248
   (:type token))
253 249
 (defmethod tok :buffer-blob [token]
254 250
   (str \" (:data token) (:trailing-white-space token) \"))
@@ -289,7 +285,7 @@
289 285
               ] 
290 286
           result)))))
291 287
 
292  
-(defn- write-line [#^clojure.contrib.pprint.PrettyWriter this]
  288
+(defn- write-line [#^Writer this]
293 289
   (dosync
294 290
    (loop [buffer (getf :buffer)]
295 291
 ;;     (prlabel wl1 (toks buffer))
@@ -302,7 +298,7 @@
302 298
 
303 299
 ;;; Add a buffer token to the buffer and see if it's time to start
304 300
 ;;; writing
305  
-(defn- add-to-buffer [#^clojure.contrib.pprint.PrettyWriter this token]
  301
+(defn- add-to-buffer [#^Writer this token]
306 302
 ;  (prlabel a2b token)
307 303
   (dosync
308 304
    (setf :buffer (conj (getf :buffer) token))
@@ -310,7 +306,7 @@
310 306
      (write-line this))))
311 307
 
312 308
 ;;; Write all the tokens that have been buffered
313  
-(defn- write-buffered-output [#^clojure.contrib.pprint.PrettyWriter this]
  309
+(defn- write-buffered-output [#^Writer this]
314 310
   (write-line this)
315 311
   (if-let [buf (getf :buffer)]
316 312
     (do
@@ -320,7 +316,7 @@
320 316
 ;;; If there are newlines in the string, print the lines up until the last newline, 
321 317
 ;;; making the appropriate adjustments. Return the remainder of the string
322 318
 (defn- write-initial-lines 
323  
-  [#^clojure.contrib.pprint.PrettyWriter this #^String s] 
  319
+  [#^Writer this #^String s] 
324 320
   (let [lines (.split s "\n" -1)]
325 321
     (if (= (count lines) 1)
326 322
       s
@@ -333,57 +329,28 @@
333 329
              (setf :pos newpos)
334 330
              (add-to-buffer this (make-buffer-blob l nil oldpos newpos))
335 331
              (write-buffered-output this))
336  
-           (.col_write this l))
337  
-         (.col_write this (int \newline))
  332
+           (.write (getf :base) l))
  333
+         (.write (getf :base) (int \newline))
338 334
          (doseq [#^String l (next (butlast lines))]
339  
-           (.col_write this l)
340  
-           (.col_write this (int \newline))
  335
+           (.write (getf :base) l)
  336
+           (.write (getf :base) (int \newline))
341 337
            (if prefix
342  
-             (.col_write this prefix)))
  338
+             (.write (getf :base) prefix)))
343 339
          (setf :buffering :writing)
344 340
          (last lines))))))
345 341
 
346 342
 
347  
-(defn write-white-space [#^clojure.contrib.pprint.PrettyWriter this]
  343
+(defn write-white-space [#^Writer this]
348 344
   (if-let [#^String tws (getf :trailing-white-space)]
349 345
     (dosync
350  
-     (.col_write this tws)
  346
+     (.write (getf :base) tws)
351 347
      (setf :trailing-white-space nil))))
352 348
 
353  
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
354  
-;;; Writer overrides
355  
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
356  
-
357  
-(declare write-char)
358  
-
359  
-(defn- -write 
360  
-  ([#^clojure.contrib.pprint.PrettyWriter this x]
361  
-     ;;     (prlabel write x (getf :mode))
362  
-     (condp = (class x)
363  
-       String 
364  
-       (let [#^String s0 (write-initial-lines this x)
365  
-	     #^String s (.replaceFirst s0 "\\s+$" "")
366  
-	     white-space (.substring s0 (count s))
367  
-	     mode (getf :mode)]
368  
-	 (dosync
369  
-          (if (= mode :writing)
370  
-            (do
371  
-             (write-white-space this)
372  
-             (.col_write this s)
373  
-             (setf :trailing-white-space white-space))
374  
-            (let [oldpos (getf :pos)
375  
-                  newpos (+ oldpos (count s0))]
376  
-              (setf :pos newpos)
377  
-              (add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
378  
-
379  
-       Integer
380  
-       (write-char this x))))
381  
-
382  
-(defn- write-char [#^clojure.contrib.pprint.PrettyWriter this #^Integer c]
  349
+(defn- write-char [#^Writer this #^Integer c]
383 350
   (if (= (getf :mode) :writing)
384 351
     (do 
385 352
       (write-white-space this)
386  
-      (.col_write this c))
  353
+      (.write (getf :base) c))
387 354
     (if (= c \newline)
388 355
       (write-initial-lines this "\n")
389 356
       (let [oldpos (getf :pos)
@@ -392,22 +359,68 @@
392 359
          (setf :pos newpos)
393 360
          (add-to-buffer this (make-buffer-blob (str (char c)) nil oldpos newpos)))))))
394 361
 
395  
-(defn- -flush [#^clojure.contrib.pprint.PrettyWriter this]
396  
-  (if (= (getf :mode) :buffering)
397  
-    (dosync 
398  
-     (write-tokens this (getf :buffer) true)
399  
-     (setf :buffer []))
400  
-    (write-white-space this)))
401 362
 
402  
-(defn- -close [this]
403  
-  (-flush this))                        ;TODO: close underlying stream?
  363
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  364
+;;; Initialize the pretty-writer instance
  365
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  366
+
  367
+
  368
+(defn pretty-writer [writer max-columns miser-width]
  369
+  (let [lb (struct logical-block nil nil (ref 0) (ref 0) (ref false) (ref false))
  370
+        fields (ref {:pretty-writer true
  371
+                     :base (column-writer writer max-columns)
  372
+                     :logical-blocks lb 
  373
+                     :sections nil
  374
+                     :mode :writing
  375
+                     :buffer []
  376
+                     :buffer-block lb
  377
+                     :buffer-level 1
  378
+                     :miser-width miser-width
  379
+                     :trailing-white-space nil
  380
+                     :pos 0})]
  381
+    (proxy [Writer IDeref] []
  382
+      (deref [] fields)
  383
+
  384
+      (write 
  385
+       ([x]
  386
+          ;;     (prlabel write x (getf :mode))
  387
+          (condp = (class x)
  388
+            String 
  389
+            (let [#^String s0 (write-initial-lines this x)
  390
+                  #^String s (.replaceFirst s0 "\\s+$" "")
  391
+                  white-space (.substring s0 (count s))
  392
+                  mode (getf :mode)]
  393
+              (dosync
  394
+               (if (= mode :writing)
  395
+                 (do
  396
+                   (write-white-space this)
  397
+                   (.write (getf :base) s)
  398
+                   (setf :trailing-white-space white-space))
  399
+                 (let [oldpos (getf :pos)
  400
+                       newpos (+ oldpos (count s0))]
  401
+                   (setf :pos newpos)
  402
+                   (add-to-buffer this (make-buffer-blob s white-space oldpos newpos))))))
  403
+
  404
+            Integer
  405
+            (write-char this x))))
  406
+
  407
+      (flush []
  408
+             (if (= (getf :mode) :buffering)
  409
+               (dosync 
  410
+                (write-tokens this (getf :buffer) true)
  411
+                (setf :buffer []))
  412
+               (write-white-space this)))
  413
+
  414
+      (close []
  415
+             (.flush this)))))
  416
+
404 417
 
405 418
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
406  
-;;; Methods for PrettyWriter
  419
+;;; Methods for pretty-writer
407 420
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
408 421
 
409  
-(defn -startBlock 
410  
-  [#^clojure.contrib.pprint.PrettyWriter this 
  422
+(defn start-block 
  423
+  [#^Writer this 
411 424
    #^String prefix #^String per-line-prefix #^String suffix]
412 425
   (dosync 
413 426
    (let [lb (struct logical-block (getf :logical-blocks) nil (ref 0) (ref 0)
@@ -419,16 +432,16 @@
419 432
          (write-white-space this)
420 433
           (when-let [cb (getf :logical-block-callback)] (cb :start))
421 434
           (if prefix 
422  
-           (.col_write this prefix))
423  
-         (let [col (.getColumn this)]
  435
+           (.write (getf :base) prefix))
  436
+         (let [col (get-column (getf :base))]
424 437
            (ref-set (:start-col lb) col)
425 438
            (ref-set (:indent lb) col)))
426 439
        (let [oldpos (getf :pos)
427 440
              newpos (+ oldpos (if prefix (count prefix) 0))]
428 441
          (setf :pos newpos)
429  
-         (add-to-buffer this (make-start-block lb oldpos newpos)))))))
  442
+         (add-to-buffer this (make-start-block-t lb oldpos newpos)))))))
430 443
 
431  
-(defn -endBlock [#^clojure.contrib.pprint.PrettyWriter this]
  444
+(defn end-block [#^Writer this]
432 445
   (dosync
433 446
    (let [lb (getf :logical-blocks)
434 447
          #^String suffix (:suffix lb)]
@@ -436,21 +449,21 @@
436 449
        (do
437 450
          (write-white-space this)
438 451
          (if suffix
439  
-           (.col_write this suffix))
  452
+           (.write (getf :base) suffix))
440 453
          (when-let [cb (getf :logical-block-callback)] (cb :end)))
441 454
        (let [oldpos (getf :pos)
442 455
              newpos (+ oldpos (if suffix (count suffix) 0))]
443 456
          (setf :pos newpos)
444  
-         (add-to-buffer this (make-end-block lb oldpos newpos))))
  457
+         (add-to-buffer this (make-end-block-t lb oldpos newpos))))
445 458
      (setf :logical-blocks (:parent lb)))))
446 459
 
447  
-(defn- -newline [#^clojure.contrib.pprint.PrettyWriter this type]
  460
+(defn nl [#^Writer this type]
448 461
   (dosync 
449 462
    (setf :mode :buffering)
450 463
    (let [pos (getf :pos)]
451  
-     (add-to-buffer this (make-nl type (getf :logical-blocks) pos pos)))))
  464
+     (add-to-buffer this (make-nl-t type (getf :logical-blocks) pos pos)))))
452 465
 
453  
-(defn- -indent [#^clojure.contrib.pprint.PrettyWriter this relative-to offset]
  466
+(defn indent [#^Writer this relative-to offset]
454 467
   (dosync 
455 468
    (let [lb (getf :logical-blocks)]
456 469
      (if (= (getf :mode) :writing)
@@ -459,15 +472,15 @@
459 472
          (ref-set (:indent lb) 
460 473
                   (+ offset (condp = relative-to
461 474
 			      :block @(:start-col lb)
462  
-			      :current (.getColumn this)))))
  475
+			      :current (get-column (getf :base))))))
463 476
        (let [pos (getf :pos)]
464  
-         (add-to-buffer this (make-indent lb relative-to offset pos pos)))))))
  477
+         (add-to-buffer this (make-indent-t lb relative-to offset pos pos)))))))
465 478
 
466  
-(defn- -getMiserWidth [#^clojure.contrib.pprint.PrettyWriter this]
  479
+(defn get-miser-width [#^Writer this]
467 480
   (getf :miser-width))
468 481
 
469  
-(defn- -setMiserWidth [#^clojure.contrib.pprint.PrettyWriter this new-miser-width]
  482
+(defn set-miser-width [#^Writer this new-miser-width]
470 483
   (dosync (setf :miser-width new-miser-width)))
471 484
 
472  
-(defn- -setLogicalBlockCallback [#^clojure.contrib.pprint.PrettyWriter this f]
  485
+(defn set-logical-block-callback [#^Writer this f]
473 486
   (dosync (setf :logical-block-callback f)))
4  src/test/clojure/clojure/contrib/pprint/test_cl_format.clj
@@ -445,14 +445,14 @@
445 445
 (cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s"))))
446 446
 
447 447
 (defn list-to-table [aseq column-width]
448  
-  (let [stream (pretty-writer (java.io.StringWriter.))]
  448
+  (let [stream (get-pretty-writer (java.io.StringWriter.))]
449 449
     (binding [*out* stream]
450 450
      (doseq [row aseq]
451 451
        (doseq [col row]
452 452
          (cl-format true "~4D~7,vT" col column-width))
453 453
        (prn)))
454 454
     (.flush stream)
455  
-    (.toString (.getWriter stream))))
  455
+    (.toString (:base @@(:base @@stream)))))
456 456
 
457 457
 (simple-tests column-writer-test
458 458
   (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8)

0 notes on commit 661dcfd

Please sign in to comment.
Something went wrong with that request. Please try again.