1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/contrib/except.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,95 @@
     1.4 +;;  Copyright (c) Stephen C. Gilardi. All rights reserved.  The use and
     1.5 +;;  distribution terms for this software are covered by the Eclipse Public
     1.6 +;;  License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can
     1.7 +;;  be found in the file epl-v10.html at the root of this distribution.  By
     1.8 +;;  using this software in any fashion, you are agreeing to be bound by the
     1.9 +;;  terms of this license.  You must not remove this notice, or any other,
    1.10 +;;  from this software.
    1.11 +;;
    1.12 +;;  except.clj
    1.13 +;;
    1.14 +;;  Provides functions that make it easy to specify the class, cause, and
    1.15 +;;  message when throwing an Exception or Error. The optional message is
    1.16 +;;  formatted using clojure.core/format.
    1.17 +;;
    1.18 +;;  scgilardi (gmail)
    1.19 +;;  Created 07 July 2008
    1.20 +
    1.21 +(ns 
    1.22 +  ^{:author "Stephen C. Gilardi",
    1.23 +     :doc "Provides functions that make it easy to specify the class, cause, and
    1.24 +message when throwing an Exception or Error. The optional message is
    1.25 +formatted using clojure.core/format."}
    1.26 +  clojure.contrib.except
    1.27 +  (:import (clojure.lang Reflector)))
    1.28 +
    1.29 +(declare throwable)
    1.30 +
    1.31 +(defn throwf
    1.32 +  "Throws an Exception or Error with an optional message formatted using
    1.33 +  clojure.core/format. All arguments are optional:
    1.34 +
    1.35 +      class? cause? format? format-args*
    1.36 +
    1.37 +  - class defaults to Exception, if present it must name a kind of
    1.38 +    Throwable
    1.39 +  - cause defaults to nil, if present it must be a Throwable
    1.40 +  - format is a format string for clojure.core/format
    1.41 +  - format-args are objects that correspond to format specifiers in
    1.42 +    format."
    1.43 +  [& args]
    1.44 +  (throw (throwable args)))
    1.45 +
    1.46 +(defn throw-if
    1.47 +  "Throws an Exception or Error if test is true. args are those documented
    1.48 +  for throwf."
    1.49 +  [test & args]
    1.50 +  (when test
    1.51 +    (throw (throwable args))))
    1.52 +
    1.53 +(defn throw-if-not
    1.54 +  "Throws an Exception or Error if test is false. args are those documented
    1.55 +  for throwf."
    1.56 +  [test & args]
    1.57 +  (when-not test
    1.58 +    (throw (throwable args))))
    1.59 +
    1.60 +(defn throw-arg
    1.61 +  "Throws an IllegalArgumentException. All arguments are optional:
    1.62 +
    1.63 +        cause? format? format-args*
    1.64 +
    1.65 +  - cause defaults to nil, if present it must be a Throwable
    1.66 +  - format is a format string for clojure.core/format
    1.67 +  - format-args are objects that correspond to format specifiers in
    1.68 +    format."
    1.69 +  [& args]
    1.70 +  (throw (throwable (cons IllegalArgumentException args))))
    1.71 +
    1.72 +(defn- throwable?
    1.73 +  "Returns true if x is a Throwable"
    1.74 +  [x]
    1.75 +  (instance? Throwable x))
    1.76 +
    1.77 +(defn- throwable
    1.78 +  "Constructs a Throwable with optional cause and formatted message. Its
    1.79 +  stack trace will begin with our caller's caller. Args are as described
    1.80 +  for throwf except throwable accepts them as list rather than inline."
    1.81 +  [args]
    1.82 +  (let [[arg] args
    1.83 +        [class & args] (if (class? arg) args (cons Exception args))
    1.84 +        [arg] args
    1.85 +        [cause & args] (if (throwable? arg) args (cons nil args))
    1.86 +        message (when args (apply format args))
    1.87 +        ctor-args (into-array Object
    1.88 +                              (cond (and message cause) [message cause]
    1.89 +                                    message [message]
    1.90 +                                    cause [cause]))
    1.91 +        throwable (Reflector/invokeConstructor class ctor-args)
    1.92 +        our-prefix "clojure.contrib.except$throwable"
    1.93 +        not-us? #(not (.startsWith (.getClassName %) our-prefix))
    1.94 +        raw-trace (.getStackTrace throwable)
    1.95 +        edited-trace (into-array StackTraceElement
    1.96 +                      (drop 3 (drop-while not-us? raw-trace)))]
    1.97 +    (.setStackTrace throwable edited-trace)
    1.98 +    throwable))