Mercurial > lasercutter
diff 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 |
line wrap: on
line diff
1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 1.2 +++ b/src/clojure/contrib/repl_utils.clj Sat Aug 21 06:25:44 2010 -0400 1.3 @@ -0,0 +1,213 @@ 1.4 +; Copyright (c) Chris Houser, Dec 2008. All rights reserved. 1.5 +; The use and distribution terms for this software are covered by the 1.6 +; Common Public License 1.0 (http://opensource.org/licenses/cpl.php) 1.7 +; which can be found in the file CPL.TXT at the root of this distribution. 1.8 +; By using this software in any fashion, you are agreeing to be bound by 1.9 +; the terms of this license. 1.10 +; You must not remove this notice, or any other, from this software. 1.11 + 1.12 +; Utilities meant to be used interactively at the REPL 1.13 + 1.14 +;; Deprecated in 1.2: source, get-source, and apropos. These are 1.15 +;; available in clojure.repl as source, source-fn, and apropos, respectively. 1.16 + 1.17 +(ns 1.18 + ^{:author "Chris Houser, Christophe Grand, Stephen Gilardi, Michel Salim", 1.19 + :doc "Utilities meant to be used interactively at the REPL"} 1.20 + clojure.contrib.repl-utils 1.21 + (:import (java.io File LineNumberReader InputStreamReader PushbackReader) 1.22 + (java.lang.reflect Modifier Method Constructor) 1.23 + (clojure.lang RT Compiler Compiler$C)) 1.24 + (:require [clojure.contrib.string :as s]) 1.25 + (:use [clojure.contrib.seq :only (indexed)] 1.26 + [clojure.contrib.javadoc.browse :only (browse-url)])) 1.27 + 1.28 +;; ---------------------------------------------------------------------- 1.29 +;; Examine Java classes 1.30 + 1.31 +(defn- sortable [t] 1.32 + (apply str (map (fn [[a b]] (str a (format "%04d" (Integer. b)))) 1.33 + (partition 2 (concat (s/partition #"\d+" t) [0]))))) 1.34 + 1.35 +(defn- param-str [m] 1.36 + (str " (" (s/join 1.37 + "," (map (fn [[c i]] 1.38 + (if (> i 3) 1.39 + (str (.getSimpleName c) "*" i) 1.40 + (s/join "," (replicate i (.getSimpleName c))))) 1.41 + (reduce (fn [pairs y] (let [[x i] (peek pairs)] 1.42 + (if (= x y) 1.43 + (conj (pop pairs) [y (inc i)]) 1.44 + (conj pairs [y 1])))) 1.45 + [] (.getParameterTypes m)))) 1.46 + ")")) 1.47 + 1.48 +(defn- member-details [m] 1.49 + (let [static? (Modifier/isStatic (.getModifiers m)) 1.50 + method? (instance? Method m) 1.51 + ctor? (instance? Constructor m) 1.52 + text (if ctor? 1.53 + (str "<init>" (param-str m)) 1.54 + (str 1.55 + (when static? "static ") 1.56 + (.getName m) " : " 1.57 + (if method? 1.58 + (str (.getSimpleName (.getReturnType m)) (param-str m)) 1.59 + (str (.getSimpleName (.getType m))))))] 1.60 + (assoc (bean m) 1.61 + :sort-val [(not static?) method? (sortable text)] 1.62 + :text text 1.63 + :member m))) 1.64 + 1.65 +(defn show 1.66 + "With one arg prints all static and instance members of x or (class x). 1.67 + Each member is listed with a number which can be given as 'selector' 1.68 + to return the member object -- the REPL will print more details for 1.69 + that member. 1.70 + 1.71 + The selector also may be a string or regex, in which case only 1.72 + members whose names match 'selector' as a case-insensitive regex 1.73 + will be printed. 1.74 + 1.75 + Finally, the selector also may be a predicate, in which case only 1.76 + members for which the predicate returns true will be printed. The 1.77 + predicate will be passed a single argument, a map that includes the 1.78 + :text that will be printed and the :member object itself, as well as 1.79 + all the properies of the member object as translated by 'bean'. 1.80 + 1.81 + Examples: (show Integer) (show []) (show String 23) (show String \"case\")" 1.82 + ([x] (show x (constantly true))) 1.83 + ([x selector] 1.84 + (let [c (if (class? x) x (class x)) 1.85 + members (sort-by :sort-val 1.86 + (map member-details 1.87 + (concat (.getFields c) 1.88 + (.getMethods c) 1.89 + (.getConstructors c))))] 1.90 + (if (number? selector) 1.91 + (:member (nth members selector)) 1.92 + (let [pred (if (ifn? selector) 1.93 + selector 1.94 + #(re-find (re-pattern (str "(?i)" selector)) (:name %)))] 1.95 + (println "=== " (Modifier/toString (.getModifiers c)) c " ===") 1.96 + (doseq [[i m] (indexed members)] 1.97 + (when (pred m) 1.98 + (printf "[%2d] %s\n" i (:text m))))))))) 1.99 + 1.100 +;; ---------------------------------------------------------------------- 1.101 +;; Examine Clojure functions (Vars, really) 1.102 + 1.103 +(defn get-source 1.104 + "Returns a string of the source code for the given symbol, if it can 1.105 + find it. This requires that the symbol resolve to a Var defined in 1.106 + a namespace for which the .clj is in the classpath. Returns nil if 1.107 + it can't find the source. For most REPL usage, 'source' is more 1.108 + convenient. 1.109 + 1.110 + Example: (get-source 'filter)" 1.111 + {:deprecated "1.2"} 1.112 + [x] 1.113 + (when-let [v (resolve x)] 1.114 + (when-let [filepath (:file (meta v))] 1.115 + (when-let [strm (.getResourceAsStream (RT/baseLoader) filepath)] 1.116 + (with-open [rdr (LineNumberReader. (InputStreamReader. strm))] 1.117 + (dotimes [_ (dec (:line (meta v)))] (.readLine rdr)) 1.118 + (let [text (StringBuilder.) 1.119 + pbr (proxy [PushbackReader] [rdr] 1.120 + (read [] (let [i (proxy-super read)] 1.121 + (.append text (char i)) 1.122 + i)))] 1.123 + (read (PushbackReader. pbr)) 1.124 + (str text))))))) 1.125 + 1.126 +(defmacro source 1.127 + "Prints the source code for the given symbol, if it can find it. 1.128 + This requires that the symbol resolve to a Var defined in a 1.129 + namespace for which the .clj is in the classpath. 1.130 + 1.131 + Example: (source filter)" 1.132 + {:deprecated "1.2"} 1.133 + [n] 1.134 + `(println (or (get-source '~n) (str "Source not found")))) 1.135 + 1.136 +(defn apropos 1.137 + "Given a regular expression or stringable thing, return a seq of 1.138 +all definitions in all currently-loaded namespaces that match the 1.139 +str-or-pattern." 1.140 + {:deprecated "1.2"} 1.141 + [str-or-pattern] 1.142 + (let [matches? (if (instance? java.util.regex.Pattern str-or-pattern) 1.143 + #(re-find str-or-pattern (str %)) 1.144 + #(s/substring? (str str-or-pattern) (str %)))] 1.145 + (mapcat (fn [ns] 1.146 + (filter matches? (keys (ns-publics ns)))) 1.147 + (all-ns)))) 1.148 + 1.149 +;; ---------------------------------------------------------------------- 1.150 +;; Handle Ctrl-C keystrokes 1.151 + 1.152 +(def ^{:doc "Threads to stop when Ctrl-C is pressed. See 'add-break-thread!'"} 1.153 + break-threads (atom {})) 1.154 + 1.155 +(let [first-time (atom true)] 1.156 + (defn start-handling-break 1.157 + "Register INT signal handler. After calling this, Ctrl-C will cause 1.158 + all break-threads to be stopped. See 'add-break-thread!'" 1.159 + [] 1.160 + (when (= :need-init 1.161 + (swap! first-time 1.162 + {:need-init false, false false, true :need-init})) 1.163 + (sun.misc.Signal/handle 1.164 + (sun.misc.Signal. "INT") 1.165 + (proxy [sun.misc.SignalHandler] [] 1.166 + (handle [sig] 1.167 + (let [exc (Exception. (str sig))] 1.168 + (doseq [tref (vals @break-threads) :when (.get tref)] 1.169 + (.stop (.get tref) exc))))))))) 1.170 + 1.171 +(defn add-break-thread! 1.172 + "Add the given thread to break-threads so that it will be stopped 1.173 + any time the user presses Ctrl-C. Calls start-handling-break for 1.174 + you. Adds the current thread if none is given." 1.175 + ([] (add-break-thread! (Thread/currentThread))) 1.176 + ([t] 1.177 + (start-handling-break) 1.178 + (let [tref (java.lang.ref.WeakReference. t)] 1.179 + (swap! break-threads assoc (.getId t) tref)))) 1.180 + 1.181 +;; ---------------------------------------------------------------------- 1.182 +;; Compiler hooks 1.183 + 1.184 +(defn expression-info 1.185 + "Uses the Clojure compiler to analyze the given s-expr. Returns 1.186 + a map with keys :class and :primitive? indicating what the compiler 1.187 + concluded about the return value of the expression. Returns nil if 1.188 + not type info can be determined at compile-time. 1.189 + 1.190 + Example: (expression-info '(+ (int 5) (float 10))) 1.191 + Returns: {:class float, :primitive? true}" 1.192 + [expr] 1.193 + (let [fn-ast (Compiler/analyze Compiler$C/EXPRESSION `(fn [] ~expr)) 1.194 + expr-ast (.body (first (.methods fn-ast)))] 1.195 + (when (.hasJavaClass expr-ast) 1.196 + {:class (.getJavaClass expr-ast) 1.197 + :primitive? (.isPrimitive (.getJavaClass expr-ast))}))) 1.198 + 1.199 +;; ---------------------------------------------------------------------- 1.200 +;; scgilardi at gmail 1.201 + 1.202 +(defn run* 1.203 + "Loads the specified namespace and invokes its \"main\" function with 1.204 + optional args." 1.205 + [ns-sym & args] 1.206 + (require ns-sym :reload-all) 1.207 + (apply (ns-resolve ns-sym 'main) args)) 1.208 + 1.209 +(defmacro run 1.210 + "Loads the specified namespace and invokes its \"main\" function with 1.211 + optional args. ns-name is not evaluated." 1.212 + [ns-name & args] 1.213 + `(run* '~ns-name ~@args)) 1.214 + 1.215 + 1.216 +(load "repl_utils/javadoc")