Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 203 lines (174 sloc) 7.719 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202
// 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.