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