annotate src/clojure/contrib/repl_utils.clj @ 10:ef7dbbd6452c

added clojure source goodness
author Robert McIntyre <rlm@mit.edu>
date Sat, 21 Aug 2010 06:25:44 -0400
parents
children
rev   line source
rlm@10 1 ; Copyright (c) Chris Houser, Dec 2008. All rights reserved.
rlm@10 2 ; The use and distribution terms for this software are covered by the
rlm@10 3 ; Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
rlm@10 4 ; which can be found in the file CPL.TXT at the root of this distribution.
rlm@10 5 ; By using this software in any fashion, you are agreeing to be bound by
rlm@10 6 ; the terms of this license.
rlm@10 7 ; You must not remove this notice, or any other, from this software.
rlm@10 8
rlm@10 9 ; Utilities meant to be used interactively at the REPL
rlm@10 10
rlm@10 11 ;; Deprecated in 1.2: source, get-source, and apropos. These are
rlm@10 12 ;; available in clojure.repl as source, source-fn, and apropos, respectively.
rlm@10 13
rlm@10 14 (ns
rlm@10 15 ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim",
rlm@10 16 :doc "Utilities meant to be used interactively at the REPL"}
rlm@10 17 clojure.contrib.repl-utils
rlm@10 18 (:import (java.io File LineNumberReader InputStreamReader PushbackReader)
rlm@10 19 (java.lang.reflect Modifier Method Constructor)
rlm@10 20 (clojure.lang RT Compiler Compiler$C))
rlm@10 21 (:require [clojure.contrib.string :as s])
rlm@10 22 (:use [clojure.contrib.seq :only (indexed)]
rlm@10 23 [clojure.contrib.javadoc.browse :only (browse-url)]))
rlm@10 24
rlm@10 25 ;; ----------------------------------------------------------------------
rlm@10 26 ;; Examine Java classes
rlm@10 27
rlm@10 28 (defn- sortable [t]
rlm@10 29 (apply str (map (fn [[a b]] (str a (format "%04d" (Integer. b))))
rlm@10 30 (partition 2 (concat (s/partition #"\d+" t) [0])))))
rlm@10 31
rlm@10 32 (defn- param-str [m]
rlm@10 33 (str " (" (s/join
rlm@10 34 "," (map (fn [[c i]]
rlm@10 35 (if (> i 3)
rlm@10 36 (str (.getSimpleName c) "*" i)
rlm@10 37 (s/join "," (replicate i (.getSimpleName c)))))
rlm@10 38 (reduce (fn [pairs y] (let [[x i] (peek pairs)]
rlm@10 39 (if (= x y)
rlm@10 40 (conj (pop pairs) [y (inc i)])
rlm@10 41 (conj pairs [y 1]))))
rlm@10 42 [] (.getParameterTypes m))))
rlm@10 43 ")"))
rlm@10 44
rlm@10 45 (defn- member-details [m]
rlm@10 46 (let [static? (Modifier/isStatic (.getModifiers m))
rlm@10 47 method? (instance? Method m)
rlm@10 48 ctor? (instance? Constructor m)
rlm@10 49 text (if ctor?
rlm@10 50 (str "<init>" (param-str m))
rlm@10 51 (str
rlm@10 52 (when static? "static ")
rlm@10 53 (.getName m) " : "
rlm@10 54 (if method?
rlm@10 55 (str (.getSimpleName (.getReturnType m)) (param-str m))
rlm@10 56 (str (.getSimpleName (.getType m))))))]
rlm@10 57 (assoc (bean m)
rlm@10 58 :sort-val [(not static?) method? (sortable text)]
rlm@10 59 :text text
rlm@10 60 :member m)))
rlm@10 61
rlm@10 62 (defn show
rlm@10 63 "With one arg prints all static and instance members of x or (class x).
rlm@10 64 Each member is listed with a number which can be given as 'selector'
rlm@10 65 to return the member object -- the REPL will print more details for
rlm@10 66 that member.
rlm@10 67
rlm@10 68 The selector also may be a string or regex, in which case only
rlm@10 69 members whose names match 'selector' as a case-insensitive regex
rlm@10 70 will be printed.
rlm@10 71
rlm@10 72 Finally, the selector also may be a predicate, in which case only
rlm@10 73 members for which the predicate returns true will be printed. The
rlm@10 74 predicate will be passed a single argument, a map that includes the
rlm@10 75 :text that will be printed and the :member object itself, as well as
rlm@10 76 all the properies of the member object as translated by 'bean'.
rlm@10 77
rlm@10 78 Examples: (show Integer) (show []) (show String 23) (show String \"case\")"
rlm@10 79 ([x] (show x (constantly true)))
rlm@10 80 ([x selector]
rlm@10 81 (let [c (if (class? x) x (class x))
rlm@10 82 members (sort-by :sort-val
rlm@10 83 (map member-details
rlm@10 84 (concat (.getFields c)
rlm@10 85 (.getMethods c)
rlm@10 86 (.getConstructors c))))]
rlm@10 87 (if (number? selector)
rlm@10 88 (:member (nth members selector))
rlm@10 89 (let [pred (if (ifn? selector)
rlm@10 90 selector
rlm@10 91 #(re-find (re-pattern (str "(?i)" selector)) (:name %)))]
rlm@10 92 (println "=== " (Modifier/toString (.getModifiers c)) c " ===")
rlm@10 93 (doseq [[i m] (indexed members)]
rlm@10 94 (when (pred m)
rlm@10 95 (printf "[%2d] %s\n" i (:text m)))))))))
rlm@10 96
rlm@10 97 ;; ----------------------------------------------------------------------
rlm@10 98 ;; Examine Clojure functions (Vars, really)
rlm@10 99
rlm@10 100 (defn get-source
rlm@10 101 "Returns a string of the source code for the given symbol, if it can
rlm@10 102 find it. This requires that the symbol resolve to a Var defined in
rlm@10 103 a namespace for which the .clj is in the classpath. Returns nil if
rlm@10 104 it can't find the source. For most REPL usage, 'source' is more
rlm@10 105 convenient.
rlm@10 106
rlm@10 107 Example: (get-source 'filter)"
rlm@10 108 {:deprecated "1.2"}
rlm@10 109 [x]
rlm@10 110 (when-let [v (resolve x)]
rlm@10 111 (when-let [filepath (:file (meta v))]
rlm@10 112 (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)]
rlm@10 113 (with-open [rdr (LineNumberReader. (InputStreamReader. strm))]
rlm@10 114 (dotimes [_ (dec (:line (meta v)))] (.readLine rdr))
rlm@10 115 (let [text (StringBuilder.)
rlm@10 116 pbr (proxy [PushbackReader] [rdr]
rlm@10 117 (read [] (let [i (proxy-super read)]
rlm@10 118 (.append text (char i))
rlm@10 119 i)))]
rlm@10 120 (read (PushbackReader. pbr))
rlm@10 121 (str text)))))))
rlm@10 122
rlm@10 123 (defmacro source
rlm@10 124 "Prints the source code for the given symbol, if it can find it.
rlm@10 125 This requires that the symbol resolve to a Var defined in a
rlm@10 126 namespace for which the .clj is in the classpath.
rlm@10 127
rlm@10 128 Example: (source filter)"
rlm@10 129 {:deprecated "1.2"}
rlm@10 130 [n]
rlm@10 131 `(println (or (get-source '~n) (str "Source not found"))))
rlm@10 132
rlm@10 133 (defn apropos
rlm@10 134 "Given a regular expression or stringable thing, return a seq of
rlm@10 135 all definitions in all currently-loaded namespaces that match the
rlm@10 136 str-or-pattern."
rlm@10 137 {:deprecated "1.2"}
rlm@10 138 [str-or-pattern]
rlm@10 139 (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern)
rlm@10 140 #(re-find str-or-pattern (str %))
rlm@10 141 #(s/substring? (str str-or-pattern) (str %)))]
rlm@10 142 (mapcat (fn [ns]
rlm@10 143 (filter matches? (keys (ns-publics ns))))
rlm@10 144 (all-ns))))
rlm@10 145
rlm@10 146 ;; ----------------------------------------------------------------------
rlm@10 147 ;; Handle Ctrl-C keystrokes
rlm@10 148
rlm@10 149 (def ^{:doc "Threads to stop when Ctrl-C is pressed. See 'add-break-thread!'"}
rlm@10 150 break-threads (atom {}))
rlm@10 151
rlm@10 152 (let [first-time (atom true)]
rlm@10 153 (defn start-handling-break
rlm@10 154 "Register INT signal handler. After calling this, Ctrl-C will cause
rlm@10 155 all break-threads to be stopped. See 'add-break-thread!'"
rlm@10 156 []
rlm@10 157 (when (= :need-init
rlm@10 158 (swap! first-time
rlm@10 159 {:need-init false, false false, true :need-init}))
rlm@10 160 (sun.misc.Signal/handle
rlm@10 161 (sun.misc.Signal. "INT")
rlm@10 162 (proxy [sun.misc.SignalHandler] []
rlm@10 163 (handle [sig]
rlm@10 164 (let [exc (Exception. (str sig))]
rlm@10 165 (doseq [tref (vals @break-threads) :when (.get tref)]
rlm@10 166 (.stop (.get tref) exc)))))))))
rlm@10 167
rlm@10 168 (defn add-break-thread!
rlm@10 169 "Add the given thread to break-threads so that it will be stopped
rlm@10 170 any time the user presses Ctrl-C. Calls start-handling-break for
rlm@10 171 you. Adds the current thread if none is given."
rlm@10 172 ([] (add-break-thread! (Thread/currentThread)))
rlm@10 173 ([t]
rlm@10 174 (start-handling-break)
rlm@10 175 (let [tref (java.lang.ref.WeakReference. t)]
rlm@10 176 (swap! break-threads assoc (.getId t) tref))))
rlm@10 177
rlm@10 178 ;; ----------------------------------------------------------------------
rlm@10 179 ;; Compiler hooks
rlm@10 180
rlm@10 181 (defn expression-info
rlm@10 182 "Uses the Clojure compiler to analyze the given s-expr. Returns
rlm@10 183 a map with keys :class and :primitive? indicating what the compiler
rlm@10 184 concluded about the return value of the expression. Returns nil if
rlm@10 185 not type info can be determined at compile-time.
rlm@10 186
rlm@10 187 Example: (expression-info '(+ (int 5) (float 10)))
rlm@10 188 Returns: {:class float, :primitive? true}"
rlm@10 189 [expr]
rlm@10 190 (let [fn-ast (Compiler/analyze Compiler$C/EXPRESSION `(fn [] ~expr))
rlm@10 191 expr-ast (.body (first (.methods fn-ast)))]
rlm@10 192 (when (.hasJavaClass expr-ast)
rlm@10 193 {:class (.getJavaClass expr-ast)
rlm@10 194 :primitive? (.isPrimitive (.getJavaClass expr-ast))})))
rlm@10 195
rlm@10 196 ;; ----------------------------------------------------------------------
rlm@10 197 ;; scgilardi at gmail
rlm@10 198
rlm@10 199 (defn run*
rlm@10 200 "Loads the specified namespace and invokes its \"main\" function with
rlm@10 201 optional args."
rlm@10 202 [ns-sym & args]
rlm@10 203 (require ns-sym :reload-all)
rlm@10 204 (apply (ns-resolve ns-sym 'main) args))
rlm@10 205
rlm@10 206 (defmacro run
rlm@10 207 "Loads the specified namespace and invokes its \"main\" function with
rlm@10 208 optional args. ns-name is not evaluated."
rlm@10 209 [ns-name & args]
rlm@10 210 `(run* '~ns-name ~@args))
rlm@10 211
rlm@10 212
rlm@10 213 (load "repl_utils/javadoc")