Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
203 lines (174 sloc) 7.54 KB
// from error_kit.clj
(defn- make-ctrl-exception [msg data]
"Create an exception object with associated data, used for passing
control and data to a dynamically containing handler."
(proxy [Error clojure.lang.IDeref] [msg]
(toString [] (str "Error Kit Control Exception: " msg ", " (pr-str data)))
(deref [] data)))
;; from mmap.clj
(defn buffer-stream
"Returns an InputStream for a ByteBuffer, such as returned by mmap."
[#^ByteBuffer buf]
(proxy [InputStream] []
(available [] (.remaining buf))
(read
([] (if (.hasRemaining buf) (.get buf) -1))
([dst offset len] (let [actlen (min (.remaining buf) len)]
(.get buf dst offset actlen)
(if (< actlen 1) -1 actlen))))))
; from repl_utils
(defn get-source
"Returns a string of the source code for the given symbol, if it can
find it. This requires that the symbol resolve to a Var defined in
a namespace for which the .clj is in the classpath. Returns nil if
it can't find the source. For most REPL usage, 'source' is more
convenient.
Example: (get-source 'filter)"
[x]
(when-let [v (resolve x)]
(when-let [strm (.getResourceAsStream (RT/baseLoader) (:file ^v))]
(with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
(dotimes [_ (dec (:line ^v))] (.readLine rdr))
(let [text (StringBuilder.)
pbr (proxy [PushbackReader] [rdr]
(read [] (let [i (proxy-super read)]
(.append text (char i))
i)))]
(read (PushbackReader. pbr))
(str text))))))
(def #^{:doc "Threads to stop when Ctrl-C is pressed. See 'add-break-thread!'"}
break-threads (atom {}))
(let [first-time (atom true)]
(defn start-handling-break
"Register INT signal handler. After calling this, Ctrl-C will cause
all break-threads to be stopped. See 'add-break-thread!'"
[]
(when (= :need-init
(swap! first-time
{:need-init false, false false, true :need-init}))
(sun.misc.Signal/handle
(sun.misc.Signal. "INT")
(proxy [sun.misc.SignalHandler] []
(handle [sig]
(let [exc (Exception. (str sig))]
(doseq [tref (vals @break-threads) :when (.get tref)]
(.stop (.get tref) exc)))))))))
;; singleton.clj
(defn per-thread-singleton
"Returns a per-thread singleton function. f is a function of no
arguments that creates and returns some object. The singleton
function will call f only once for each thread, and cache its value
for subsequent calls from the same thread. This allows you to
safely and lazily initialize shared objects on a per-thread basis.
Warning: due to a bug in JDK 5, it may not be safe to use a
per-thread-singleton in the initialization function for another
per-thread-singleton. See
http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=5025230"
[f]
(let [thread-local (proxy [ThreadLocal] [] (initialValue [] (f)))]
(fn [] (.get thread-local))))
;; cl-format.clj
(defn- downcase-writer
"Returns a proxy that wraps writer, converting all characters to lower case"
[#^java.io.Writer writer]
(proxy [java.io.Writer] []
(close [] (.close writer))
(flush [] (.flush writer))
(write ([#^chars cbuf #^Integer off #^Integer len]
(.write writer cbuf off len))
([x]
(condp = (class x)
String
(let [s #^String x]
(.write writer (.toLowerCase s)))
Integer
(let [c #^Character x]
(.write writer (int (Character/toLowerCase (char c))))))))))
(defn- upcase-writer
"Returns a proxy that wraps writer, converting all characters to upper case"
[#^java.io.Writer writer]
(proxy [java.io.Writer] []
(close [] (.close writer))
(flush [] (.flush writer))
(write ([#^chars cbuf #^Integer off #^Integer len]
(.write writer cbuf off len))
([x]
(condp = (class x)
String
(let [s #^String x]
(.write writer (.toUpperCase s)))
Integer
(let [c #^Character x]
(.write writer (int (Character/toUpperCase (char c))))))))))
;;; my version
(defn upcase-writer
[#^System.IO.TextWriter tw]
(proxy [System.IO.TextWriter] []
(Write ([#^chars cbuf #^Int32 off #^Int32 len] (.Write tw cbuf off len))
([x] (condp = (class x)
System.String (let [s #^System.String x] (.Write tw (. s ToUpper)))
Int32 (let [c #^Int32 x] (.Write tw (Char/ToUpper (char c)))))))))
(defn upcase-writer
[#^System.IO.TextWriter tw]
(proxy [System.IO.TextWriter] []
(Write ([#^chars cbuf #^Int32 off #^Int32 len] (.Write tw cbuf off len))
([x] (condp = (class x)
System.String (let [s x] (.Write tw (. s ToUpper)))
Int32 (let [c x] (.Write tw (Char/ToUpper (char c)))))))))
(defn- capitalize-word-writer
"Returns a proxy that wraps writer, captializing all words"
[#^java.io.Writer writer]
(let [last-was-whitespace? (ref true)]
(proxy [java.io.Writer] []
(close [] (.close writer))
(flush [] (.flush writer))
(write
([#^chars cbuf #^Integer off #^Integer len]
(.write writer cbuf off len))
([x]
(condp = (class x)
String
(let [s #^String x]
(.write writer
#^String (capitalize-string (.toLowerCase s) @last-was-whitespace?))
(dosync
(ref-set last-was-whitespace?
(Character/isWhitespace
#^Character (nth s (dec (count s)))))))
Integer
(let [c (char x)]
(let [mod-c (if @last-was-whitespace? (Character/toUpperCase #^Character (char x)) c)]
(.write writer (int mod-c))
(dosync (ref-set last-was-whitespace? (Character/isWhitespace #^Character (char x))))))))))))
(defn- init-cap-writer
"Returns a proxy that wraps writer, capitalizing the first word"
[#^java.io.Writer writer]
(let [capped (ref false)]
(proxy [java.io.Writer] []
(close [] (.close writer))
(flush [] (.flush writer))
(write ([#^chars cbuf #^Integer off #^Integer len]
(.write writer cbuf off len))
([x]
(condp = (class x)
String
(let [s (.toLowerCase #^String x)]
(if (not @capped)
(let [m (re-matcher #"\S" s)
match (re-find m)
offset (and match (.start m))]
(if offset
(do (.write writer
(str (subs s 0 offset)
(Character/toUpperCase #^Character (nth s offset))
(.toLowerCase #^String (subs s (inc offset)))))
(dosync (ref-set capped true)))
(.write writer s)))
(.write writer (.toLowerCase s))))
Integer
(let [c #^Character (char x)]
(if (and (not @capped) (Character/isLetter c))
(do
(dosync (ref-set capped true))
(.write writer (int (Character/toUpperCase c))))
(.write writer (int (Character/toLowerCase c)))))))))))
Something went wrong with that request. Please try again.