Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 203 lines (174 sloc) 7.719 kB
36c17db @dmiller Added proxy. Closes #9
dmiller authored
1 // from error_kit.clj
2 (defn- make-ctrl-exception [msg data]
3 "Create an exception object with associated data, used for passing
4 control and data to a dynamically containing handler."
5 (proxy [Error clojure.lang.IDeref] [msg]
6 (toString [] (str "Error Kit Control Exception: " msg ", " (pr-str data)))
7 (deref [] data)))
8
9
10 ;; from mmap.clj
11 (defn buffer-stream
12 "Returns an InputStream for a ByteBuffer, such as returned by mmap."
13 [#^ByteBuffer buf]
14 (proxy [InputStream] []
15 (available [] (.remaining buf))
16 (read
17 ([] (if (.hasRemaining buf) (.get buf) -1))
18 ([dst offset len] (let [actlen (min (.remaining buf) len)]
19 (.get buf dst offset actlen)
20 (if (< actlen 1) -1 actlen))))))
21
22
23 ; from repl_utils
24 (defn get-source
25 "Returns a string of the source code for the given symbol, if it can
26 find it. This requires that the symbol resolve to a Var defined in
27 a namespace for which the .clj is in the classpath. Returns nil if
28 it can't find the source. For most REPL usage, 'source' is more
29 convenient.
30
31 Example: (get-source 'filter)"
32 [x]
33 (when-let [v (resolve x)]
34 (when-let [strm (.getResourceAsStream (RT/baseLoader) (:file ^v))]
35 (with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
36 (dotimes [_ (dec (:line ^v))] (.readLine rdr))
37 (let [text (StringBuilder.)
38 pbr (proxy [PushbackReader] [rdr]
39 (read [] (let [i (proxy-super read)]
40 (.append text (char i))
41 i)))]
42 (read (PushbackReader. pbr))
43 (str text))))))
44
45
46 (def #^{:doc "Threads to stop when Ctrl-C is pressed. See 'add-break-thread!'"}
47 break-threads (atom {}))
48
49 (let [first-time (atom true)]
50 (defn start-handling-break
51 "Register INT signal handler. After calling this, Ctrl-C will cause
52 all break-threads to be stopped. See 'add-break-thread!'"
53 []
54 (when (= :need-init
55 (swap! first-time
56 {:need-init false, false false, true :need-init}))
57 (sun.misc.Signal/handle
58 (sun.misc.Signal. "INT")
59 (proxy [sun.misc.SignalHandler] []
60 (handle [sig]
61 (let [exc (Exception. (str sig))]
62 (doseq [tref (vals @break-threads) :when (.get tref)]
63 (.stop (.get tref) exc)))))))))
64
65
66 ;; singleton.clj
67
68 (defn per-thread-singleton
69 "Returns a per-thread singleton function. f is a function of no
70 arguments that creates and returns some object. The singleton
71 function will call f only once for each thread, and cache its value
72 for subsequent calls from the same thread. This allows you to
73 safely and lazily initialize shared objects on a per-thread basis.
74
75 Warning: due to a bug in JDK 5, it may not be safe to use a
76 per-thread-singleton in the initialization function for another
77 per-thread-singleton. See
78 http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=5025230"
79 [f]
80 (let [thread-local (proxy [ThreadLocal] [] (initialValue [] (f)))]
81 (fn [] (.get thread-local))))
82
83 ;; cl-format.clj
84
85 (defn- downcase-writer
86 "Returns a proxy that wraps writer, converting all characters to lower case"
87 [#^java.io.Writer writer]
88 (proxy [java.io.Writer] []
89 (close [] (.close writer))
90 (flush [] (.flush writer))
91 (write ([#^chars cbuf #^Integer off #^Integer len]
92 (.write writer cbuf off len))
93 ([x]
94 (condp = (class x)
95 String
96 (let [s #^String x]
97 (.write writer (.toLowerCase s)))
98
99 Integer
100 (let [c #^Character x]
101 (.write writer (int (Character/toLowerCase (char c))))))))))
102
103 (defn- upcase-writer
104 "Returns a proxy that wraps writer, converting all characters to upper case"
105 [#^java.io.Writer writer]
106 (proxy [java.io.Writer] []
107 (close [] (.close writer))
108 (flush [] (.flush writer))
109 (write ([#^chars cbuf #^Integer off #^Integer len]
110 (.write writer cbuf off len))
111 ([x]
112 (condp = (class x)
113 String
114 (let [s #^String x]
115 (.write writer (.toUpperCase s)))
116
117 Integer
118 (let [c #^Character x]
119 (.write writer (int (Character/toUpperCase (char c))))))))))
120
121
122 ;;; my version
123
124 (defn upcase-writer
125 [#^System.IO.TextWriter tw]
126 (proxy [System.IO.TextWriter] []
127 (Write ([#^chars cbuf #^Int32 off #^Int32 len] (.Write tw cbuf off len))
226e83b @dmiller Updated to Java commit 53cc7a6: first cut at mutable vector, plus a l…
dmiller authored
128 ([x] (condp = (class x)
36c17db @dmiller Added proxy. Closes #9
dmiller authored
129 System.String (let [s #^System.String x] (.Write tw (. s ToUpper)))
226e83b @dmiller Updated to Java commit 53cc7a6: first cut at mutable vector, plus a l…
dmiller authored
130 Int32 (let [c #^Int32 x] (.Write tw (Char/ToUpper (char c)))))))))
36c17db @dmiller Added proxy. Closes #9
dmiller authored
131
226e83b @dmiller Updated to Java commit 53cc7a6: first cut at mutable vector, plus a l…
dmiller authored
132 (defn upcase-writer
133 [#^System.IO.TextWriter tw]
134 (proxy [System.IO.TextWriter] []
135 (Write ([#^chars cbuf #^Int32 off #^Int32 len] (.Write tw cbuf off len))
136 ([x] (condp = (class x)
137 System.String (let [s x] (.Write tw (. s ToUpper)))
138 Int32 (let [c x] (.Write tw (Char/ToUpper (char c)))))))))
36c17db @dmiller Added proxy. Closes #9
dmiller authored
139
140
141 (defn- capitalize-word-writer
142 "Returns a proxy that wraps writer, captializing all words"
143 [#^java.io.Writer writer]
144 (let [last-was-whitespace? (ref true)]
145 (proxy [java.io.Writer] []
146 (close [] (.close writer))
147 (flush [] (.flush writer))
148 (write
149 ([#^chars cbuf #^Integer off #^Integer len]
150 (.write writer cbuf off len))
151 ([x]
152 (condp = (class x)
153 String
154 (let [s #^String x]
155 (.write writer
156 #^String (capitalize-string (.toLowerCase s) @last-was-whitespace?))
157 (dosync
158 (ref-set last-was-whitespace?
159 (Character/isWhitespace
160 #^Character (nth s (dec (count s)))))))
161
162 Integer
163 (let [c (char x)]
164 (let [mod-c (if @last-was-whitespace? (Character/toUpperCase #^Character (char x)) c)]
165 (.write writer (int mod-c))
166 (dosync (ref-set last-was-whitespace? (Character/isWhitespace #^Character (char x))))))))))))
167
168 (defn- init-cap-writer
169 "Returns a proxy that wraps writer, capitalizing the first word"
170 [#^java.io.Writer writer]
171 (let [capped (ref false)]
172 (proxy [java.io.Writer] []
173 (close [] (.close writer))
174 (flush [] (.flush writer))
175 (write ([#^chars cbuf #^Integer off #^Integer len]
176 (.write writer cbuf off len))
177 ([x]
178 (condp = (class x)
179 String
180 (let [s (.toLowerCase #^String x)]
181 (if (not @capped)
182 (let [m (re-matcher #"\S" s)
183 match (re-find m)
184 offset (and match (.start m))]
185 (if offset
186 (do (.write writer
187 (str (subs s 0 offset)
188 (Character/toUpperCase #^Character (nth s offset))
189 (.toLowerCase #^String (subs s (inc offset)))))
190 (dosync (ref-set capped true)))
191 (.write writer s)))
192 (.write writer (.toLowerCase s))))
193
194 Integer
195 (let [c #^Character (char x)]
196 (if (and (not @capped) (Character/isLetter c))
197 (do
198 (dosync (ref-set capped true))
199 (.write writer (int (Character/toUpperCase c))))
200 (.write writer (int (Character/toLowerCase c)))))))))))
201
202
Something went wrong with that request. Please try again.