Mercurial > lasercutter

     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")
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children