1 files changed, 79 insertions, 0 deletions
diff --git a/src/clojure/contrib/except.clj b/src/clojure/contrib/except.clj
new file mode 100644
index 00000000..e65044dc
--- /dev/null
+++ b/src/clojure/contrib/except.clj
@@ -0,0 +1,79 @@
+;;  Copyright (c) Stephen C. Gilardi. All rights reserved. The use and
+;;  distribution terms for this software are covered by the Common Public
+;;  License 1.0 (http://opensource.org/licenses/cpl.php) which can be found
+;;  in the file CPL.TXT at the root of this distribution. By using this
+;;  software in any fashion, you are agreeing to be bound by the terms of
+;;  this license. You must not remove this notice, or any other, from this
+;;  software.
+;;
+;;  except.clj
+;;
+;;  Provides functions that make it easy to specify the class and message
+;;  when throwing an Exception or Error. The optional message is formatted
+;;  using clojure/format.
+;;
+;;  scgilardi (gmail)
+;;  Created 07 July 2008
+
+(ns clojure.contrib.except
+  (:import (clojure.lang Reflector)))
+
+(declare throwable)
+
+(defn throwf
+  "Throws an Exception or Error with an optional message formatted using
+  clojure/format. All arguments are optional:
+
+      class? format? format-args*
+
+  - class defaults to Exception, if present it must name a kind of
+    Throwable
+  - format is a format string for clojure/format
+  - format-args are objects that correspond to format specifiers in
+    format."
+  [& args]
+  (throw (throwable args)))
+
+(defn throw-if
+  "Throws an Exception or Error if test is true. args are those documented
+  for throwf."
+  [test & args]
+  (when test
+    (throw (throwable args))))
+
+;; throw-if-not is synonymous with assert, but clojure/assert exists
+
+(defn throw-if-not
+  "Throws an Exception or Error if test is false. args are those documented
+  for throwf."
+  [test & args]
+  (when-not test
+    (throw (throwable args))))
+
+(defn throw-arg
+  "Throws an IllegalArgumentException. All arguments are optional:
+
+        format? format-args*
+
+  - format is a format string for clojure/format
+  - format-args are objects that correspond to format specifiers in
+    format."
+  [& args]
+  (throw (throwable (cons IllegalArgumentException args))))
+
+(defn- throwable
+  "Constructs a Throwable with an optional formatted message. Its stack
+  trace will begin with our caller's caller. Args are as described for
+  throwf except throwable accepts them as list rather than inline."
+  [args]
+  (let [[class & [fmt & fmt-args]] (if (class? (first args))
+                                     args
+                                     (cons Exception args))
+        ctor-args (into-array (if fmt [(apply format fmt fmt-args)] []))
+        throwable (Reflector/invokeConstructor class ctor-args)
+        our-prefix "clojure.contrib.except.throwable"
+        not-us? #(not (.startsWith (.getClassName %) our-prefix))
+        raw-trace (.getStackTrace throwable)
+        edited-trace (into-array (drop 3 (drop-while not-us? raw-trace)))]
+    (.setStackTrace throwable edited-trace)
+    throwable))