Configurable colors

README.md

@@ -6,6 +6,8 @@ For example, to print a nice stack trace in a REPL:
 
     => (use 'clj-stacktrace.repl)
     => ("foo")
+    java.lang.ClassCastException: java.lang.String cannot be cast to clojure.lang.IFn (NO_SOURCE_FILE:0)
+    => (pst)
     java.lang.ClassCastException: java.lang.String cannot be cast to clojure.lang.IFn (NO_SOURCE_FILE:0)
            Compiler.java:5440 clojure.lang.Compiler.eval
            Compiler.java:5391 clojure.lang.Compiler.eval
@@ -25,18 +27,23 @@ For example, to print a nice stack trace in a REPL:
              NO_SOURCE_FILE:2 user/eval100
            Compiler.java:5424 clojure.lang.Compiler.eval
 
-
 In stack traces printed by `pst`:
 
-* Java methods are described with the usual `name.space.ClassName.methodName` convention and Clojure functions with their own `name.space/function-name` convention.
-* Anonymous clojure functions are denoted by adding an `[fn]` to their enclosing, named function.
+* Java methods are described with the usual
+  `name.space.ClassName.methodName` convention and Clojure functions
+  with their own `name.space/function-name` convention.
+* Anonymous clojure functions are denoted by adding an `[fn]` to their
+  enclosing, named function.
 * "Caused by" cascades are shown as in regular java stack traces.
 * Elements are vertically aligned for better readability.
 * Printing is directed to `*out*`.
 
-If you want to direct the printing to somewhere other than `*out*`, either use `pst-on` to specify the output location or `pst-str` to capture the printing as a string.
+If you want to direct the printing to somewhere other than `*out*`,
+either use `pst-on` to specify the output location.
 
-The library also offers an API for programatically 'parsing' exceptions. This API is used internal for `pst` and can be used to e.g. improve development tools. Try for example:
+The library also offers an API for programatically 'parsing'
+exceptions. This API is used internal for `pst` and can be used to
+e.g. improve development tools. Try for example:
 
 ```clj
 (use 'clj-stacktrace.core)
@@ -46,7 +53,7 @@ The library also offers an API for programatically 'parsing' exceptions. This AP
     (parse-exception e)))
 ```
 
-If you use Leiningen, you can install clj-stacktrace on a per-user basis:
+If you use Leiningen, you can install clj-stacktrace on a user-level basis:
 
     $ lein plugin install clj-stacktrace 0.2.4
 

src/clj_stacktrace/core.clj

@@ -76,7 +76,7 @@
         :method (.getMethodName elem)))))
 
 (defn parse-trace-elems
-  "Returns a seq of maps providing usefull information about the java stack
+  "Returns a seq of maps providing useful information about the java stack
   trace elements. See parse-trace-elem."
   [elems]
   (map parse-trace-elem elems))
@@ -110,7 +110,7 @@
       base)))
 
 (defn parse-exception
-  "Returns a Clojure map providing usefull informaiton about the exception.
+  "Returns a Clojure map providing useful information about the exception.
   The map has keys
   :class        Class of the exception.
   :message      Regular exception message string.

src/clj_stacktrace/repl.clj

@@ -1,37 +1,51 @@
 (ns clj-stacktrace.repl
-  (:use clj-stacktrace.core)
-  (:require [clj-stacktrace.utils :as utils]))
+  (:use [clj-stacktrace.core :only [parse-exception]]
+        [clj-stacktrace.utils :only [omit-frames fence rjust]]))
 
 (def color-codes
-  {:red     "\033[31m"
-   :green   "\033[32m"
-   :yellow  "\033[33m"
-   :blue    "\033[34m"
+  {:red "\033[31m"
+   :green "\033[32m"
+   :yellow "\033[33m"
+   :blue "\033[34m"
    :magenta "\033[35m"
-   :cyan    "\033[36m"
-   :default "\033[39m"})
-
-(defn- colored
-  [color? color text]
-  (if color?
-    (str (color-codes color) text (color-codes :default))
-    text))
-
-(defn elem-color
-  "Returns a symbol identifying the color appropriate for the given trace elem.
-  :green   All Java elems
-  :yellow  Any fn in the user or repl* namespaces (i.e. entered at REPL)
-  :blue    Any fn in clojure.* (e.g. clojure.core, clojure.contrib.*)
-  :magenta Anything else - i.e. Clojure libraries and app code."
+   :cyan "\033[36m"
+
+   :red-bg "\033[41m"
+   :green-bg "\033[42m"
+   :yellow-bg "\033[43m"
+   :blue-bg "\033[44m"
+   :magenta-bg "\033[45m"
+   :cyan-bg "\033[46m"})
+
+(def ^{:private true} default-colors {:error-color :red
+                                      :user-code-color :green
+                                      :repl-color :yellow
+                                      :java-color :blue
+                                      :clojure-color :magenta
+                                      :clojure-java-color :cyan})
+
+(defn- colored [color? color text color-overrides]
+  (let [colors (merge default-colors color-overrides)]
+    (if color?
+      (str (color-codes (colors color)) text "\033[39m")
+      text)))
+
+(defn- elem-color
+  "Returns a keyword identifying the color appropriate for the given trace elem.
+  :clojure-java-color Java elems in clojure.*
+  :java-color         Any other Java elems
+  :repl-color         Any fn in the user or repl* namespaces (i.e. entered at REPL)
+  :clojure-color      Any fn in clojure.* (e.g. clojure.core, clojure.contrib.*)
+  :user-code-color    Anything else - i.e. Clojure libraries and app code."
   [elem]
   (if (:java elem)
     (if (re-find #"^clojure\." (:class elem))
-      :cyan
-      :blue)
-    (cond (nil? (:ns elem)) :yellow
-          (re-find #"^(user|repl)" (:ns elem)) :yellow
-          (re-find #"^clojure\." (:ns elem)) :magenta
-          :user-code :green)))
+      :clojure-java-color 
+      :java-color)
+    (cond (nil? (:ns elem)) :repl-color 
+          (re-find #"^(user|repl)" (:ns elem)) :repl-color 
+          (re-find #"^clojure\." (:ns elem)) :clojure-color 
+          :else :user-code-color )))
 
 (defn source-str [parsed]
   (if (and (:file parsed) (:line parsed))
@@ -47,76 +61,82 @@
 (defn method-str [parsed]
   (if (:java parsed) (java-method-str parsed) (clojure-method-str parsed)))
 
-(defn pst-class-on [^java.io.Writer on color? ^Class class]
-  (.append on ^String (colored color? :red (str (.getName class) ": ")))
+(defn pst-class-on [^java.io.Writer on color? ^Class class color-overrides]
+  (.append on ^String (colored color? :error-color (str (.getName class) ": ") color-overrides))
   (.flush on))
 
-(defn pst-message-on [^java.io.Writer on color? message]
-  (.append on ^String (colored color? :red message))
+(defn pst-message-on [^java.io.Writer on color? message color-overrides]
+  (.append on ^String (colored color? :error-color message color-overrides))
   (.append on "\n")
   (.flush on))
 
 (defn pst-elem-str
-  [color? parsed-elem print-width]
+  [color? parsed-elem print-width color-overrides]
   (colored color? (elem-color parsed-elem)
-           (str (utils/rjust print-width (source-str parsed-elem))
-                " " (method-str parsed-elem))))
+           (str (rjust print-width (source-str parsed-elem))
+                " " (method-str parsed-elem))
+           color-overrides))
 
 (defn pst-elems-on
-  [^java.io.Writer on color? parsed-elems & [source-width]]
+  [^java.io.Writer on color? parsed-elems & [source-width color-overrides]]
   (let [print-width (+ 6 (or source-width
-                             (utils/fence
-                              (sort
-                               (map #(.length ^String %)
-                                    (map source-str parsed-elems))))))]
+                             (fence (sort (for [elem parsed-elems]
+                                            (count (source-str elem)))))))]
     (doseq [parsed-elem parsed-elems]
-      (.append on ^String (pst-elem-str color? parsed-elem print-width))
+      (.append on ^String (pst-elem-str color? parsed-elem print-width color-overrides))
       (.append on "\n")
       (.flush on))))
 
 (defn pst-caused-by-on
-  [^java.io.Writer on color?]
-  (.append on ^String (colored color? :red "Caused by: "))
+  [^java.io.Writer on color? color-overrides]
+  (.append on ^String (colored color? :error-color "Caused by: " color-overrides))
   (.flush on))
 
 (defn- pst-cause-on
-  [^java.io.Writer on color? exec source-width]
-  (pst-caused-by-on on color?)
-  (pst-class-on on color? (:class exec))
-  (pst-message-on on color? (:message exec))
-  (pst-elems-on on color? (:trimmed-elems exec) source-width)
+  [^java.io.Writer on exec {:keys [source-width omit color?]} color-overrides]
+  (pst-caused-by-on on color? color-overrides)
+  (pst-class-on on color? (:class exec) color-overrides)
+  (pst-message-on on color? (:message exec) color-overrides)
+  (pst-elems-on on color? (omit-frames (:trimmed-elems exec) omit)
+                source-width color-overrides)
   (if-let [cause (:cause exec)]
-    (pst-cause-on on color? cause source-width)))
+    (pst-cause-on on color? cause source-width color-overrides)))
 
 (defn find-source-width
   "Returns the width of the longest source-string among all trace elems of the
   excp and its causes."
   [excp]
   (let [this-source-width (->> (:trace-elems excp)
                                (map (comp count source-str))
-                               (sort)
-                               (utils/fence))]
+                               (sort) (fence))]
     (if-let [cause (:cause excp)]
       (max this-source-width (find-source-width cause))
       this-source-width)))
 
-(defn pst-on [on color? e]
+(defn pst-on
   "Prints to the given Writer on a pretty stack trace for the given exception e,
   ANSI colored if color? is true."
+  [on e {:keys [omit color?] :as opts}]
   (let [exec         (parse-exception e)
-        source-width (find-source-width exec)]
-    (pst-class-on on color? (:class exec))
-    (pst-message-on on color? (:message exec))
-    (pst-elems-on on color? (:trace-elems exec) source-width)
+        source-width (find-source-width exec)
+        color?       (or color? (:color? opts) (:test-color opts))
+        color-overrides   (select-keys opts (keys default-colors))]
+    (pst-class-on on color? (:class exec) color-overrides)
+    (pst-message-on on color? (:message exec) color-overrides)
+    (pst-elems-on on color? (omit-frames (:trace-elems exec) omit) source-width color-overrides)
     (if-let [cause (:cause exec)]
-      (pst-cause-on on color? cause source-width))))
+      (pst-cause-on on cause
+                    (assoc opts
+                      :source-width source-width
+                      :color? color?)
+                    color-overrides))))
 
 (defn pst
   "Print to *out* a pretty stack trace for an exception, by default *e."
-  [& [e]]
-  (pst-on *out* false (or e *e)))
+  [& [e & {:as opts}]]
+  (pst-on *out* (or e *e) opts))
 
 (defn pst+
   "Like pst, but with ANSI terminal color coding."
-  [& [e]]
-  (pst-on *out* true (or e *e)))
+  [& [e & {:as opts}]]
+  (pst-on *out* (or e *e) (assoc opts :color? true)))

src/clj_stacktrace/utils.clj

@@ -37,3 +37,19 @@
         q3  (quartile3 coll)
         iqr (- q3 q1)]
     (int (+ q3 (/ (* 3 iqr) 2)))))
+
+(defn- omitter-fn [to-omit]
+  (if (instance? java.util.regex.Pattern to-omit)
+    ;; Curse you, non ifn regexes!
+    (comp (partial re-find to-omit) pr-str)
+    to-omit))
+
+(defn omit-frames
+  "Remove frames matching to-omit, which can be a function or regex."
+  [trace-elems to-omit]
+  (if-let [omit? (omitter-fn to-omit)]
+    (reduce (fn [trace-elems elem]
+              (if (omit? elem)
+                trace-elems
+               (conj trace-elems elem))) [] trace-elems)
+    trace-elems))

src/leiningen/hooks/clj_stacktrace_test.clj

@@ -3,12 +3,11 @@
         [robert.hooke :only [add-hook]]))
 
 (defn- hook-form [form project]
-  (let [pst (if (:test-color (:clj-stacktrace project))
-              'clj-stacktrace.repl/pst+
-              'clj-stacktrace.repl/pst)]
-    `(do (alter-var-root (resolve '~'clojure.stacktrace/print-cause-trace)
-                         (constantly @(resolve '~pst)))
-         ~form)))
+  `(do (alter-var-root (resolve '~'clojure.stacktrace/print-cause-trace)
+                       (constantly (fn [e#]
+                                     (@(resolve '~'pst) e#
+                                      ~(:clj-stacktrace project)))))
+       ~form))
 
 (defn- add-stacktrace-hook [eval-in-project project form & [h s init]]
   (eval-in-project project (hook-form form project)

test/clj_stacktrace/repl_test.clj

@@ -1,7 +1,6 @@
 (ns clj-stacktrace.repl-test
-  (:use clojure.test)
-  (:use clj-stacktrace.utils)
-  (:use clj-stacktrace.repl))
+  (:use [clojure.test]
+        [clj-stacktrace.repl]))
 
 (defmacro with-cascading-exception
   "Execute body in the context of a variable bound to an exception instance
@@ -18,14 +17,34 @@
     (binding [*e e]
       (is (with-out-str (pst))))))
 
-(deftest test-pst-str
-  (with-cascading-exception e
-    (is (pst-str e))
-    (binding [*e e]
-      (is (pst-str)))))
-
 (deftest test-pst+
   (with-cascading-exception e
     (is (with-out-str (pst+ e)))
     (binding [*e e]
       (is (with-out-str (pst+))))))
+
+(deftest test-omit
+  (with-cascading-exception e
+    (is (not (re-find #"repl-test" (with-out-str
+                                     (pst e :omit #"repl-test")))))
+    (is (not (re-find #"Compiler.java"
+                      (with-out-str
+                        (pst e :omit (fn [e]
+                                       (= "Compiler.java" (:file e))))))))))
+
+;; Color configuration tests
+
+(defn starts-with? [color s]
+  (.startsWith s (color-codes color))) 
+
+(deftest pst-uses-no-color
+  (with-cascading-exception ex
+    (is (not (starts-with? :red (with-out-str (pst ex)))))))
+
+(deftest defaults-to-red-exceptions
+  (with-cascading-exception ex
+    (is (starts-with? :red (with-out-str (pst+ ex))))))
+
+(deftest configure-colors
+  (with-cascading-exception ex
+    (is (starts-with? :blue (with-out-str (pst+ ex :error-color :blue ))))))