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")