Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

203 lines (174 sloc) 7.719 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)))))))))))
Jump to Line
Something went wrong with that request. Please try again.