aboutsummaryrefslogtreecommitdiff
path: root/src/clojure/contrib
diff options
context:
space:
mode:
Diffstat (limited to 'src/clojure/contrib')
-rw-r--r--src/clojure/contrib/cond.clj31
-rw-r--r--src/clojure/contrib/def.clj75
-rw-r--r--src/clojure/contrib/except.clj79
-rw-r--r--src/clojure/contrib/fcase.clj92
-rw-r--r--src/clojure/contrib/lazy_seqs.clj94
-rw-r--r--src/clojure/contrib/memoize.clj31
-rw-r--r--src/clojure/contrib/miglayout.clj63
-rw-r--r--src/clojure/contrib/miglayout/internal.clj75
-rw-r--r--src/clojure/contrib/miglayout/test.clj86
-rw-r--r--src/clojure/contrib/ns_utils.clj86
-rw-r--r--src/clojure/contrib/pred.clj70
-rw-r--r--src/clojure/contrib/sql.clj138
-rw-r--r--src/clojure/contrib/sql/internal.clj43
-rw-r--r--src/clojure/contrib/sql/test.clj85
-rw-r--r--src/clojure/contrib/test_clojure.clj32
-rw-r--r--src/clojure/contrib/test_clojure/numbers.clj69
-rw-r--r--src/clojure/contrib/test_clojure/printer.clj81
-rw-r--r--src/clojure/contrib/test_clojure/reader.clj171
-rw-r--r--src/clojure/contrib/test_is.clj238
19 files changed, 1639 insertions, 0 deletions
diff --git a/src/clojure/contrib/cond.clj b/src/clojure/contrib/cond.clj
new file mode 100644
index 00000000..220192a5
--- /dev/null
+++ b/src/clojure/contrib/cond.clj
@@ -0,0 +1,31 @@
+;; 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.
+;;
+;; File: cond.clj
+;;
+;; scgilardi (gmail)
+;; 2 October 2008
+
+(ns clojure.contrib.cond)
+
+(defmacro cond-let
+ "Takes a binding-form and a set of test/expr pairs. Evaluates each test
+ one at a time. If a test returns logical true, cond-let evaluates and
+ returns expr with binding-form bound to the value of test and doesn't
+ evaluate any of the other tests or exprs. To provide a default value
+ either provide a literal that evaluates to logical true and is
+ binding-compatible with binding-form, or use :else as the test and don't
+ refer to any parts of binding-form in the expr. (cond-let binding-form)
+ returns nil."
+ [binding-form & clauses]
+ (when-let [[test expr & more] clauses]
+ (if (= test :else)
+ expr
+ `(if ~test
+ (let [~binding-form ~test] ~expr)
+ (cond-let ~binding-form ~@more)))))
diff --git a/src/clojure/contrib/def.clj b/src/clojure/contrib/def.clj
new file mode 100644
index 00000000..d6eb14af
--- /dev/null
+++ b/src/clojure/contrib/def.clj
@@ -0,0 +1,75 @@
+;; 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.
+;;
+;; File: def.clj
+;;
+;; def.clj provides variants of def that make including doc strings and
+;; making private definitions more succinct.
+;;
+;; scgilardi (gmail)
+;; 17 May 2008
+
+(ns clojure.contrib.def)
+
+(defmacro init-once
+ "Initializes a var exactly once. The var must already exist.
+ (NOTE: Since SVN 1008, Clojure includes defonce. Please use that instead
+ of init-once.)"
+ [var init]
+ `(let [v# (resolve '~var)]
+ (when-not (.isBound v#)
+ (.bindRoot v# ~init))))
+
+(defmacro defvar
+ "Defines a var with an optional intializer and doc string"
+ ([name]
+ (list `def name))
+ ([name init]
+ (list `def name init))
+ ([name init doc]
+ (list `def (with-meta name (assoc (meta name) :doc doc)) init)))
+
+(defmacro defunbound
+ "Defines an unbound var with optional doc string"
+ ([name]
+ (list `def name))
+ ([name doc]
+ (list `def (with-meta name (assoc (meta name) :doc doc)))))
+
+(defmacro defmacro-
+ "Same as defmacro but yields a private definition"
+ [name & decls]
+ (list* `defmacro (with-meta name (assoc (meta name) :private true)) decls))
+
+(defmacro defvar-
+ "Same as defvar but yields a private definition"
+ [name & decls]
+ (list* `defvar (with-meta name (assoc (meta name) :private true)) decls))
+
+(defmacro defunbound-
+ "Same as defunbound but yields a private definition"
+ [name & decls]
+ (list* `defunbound (with-meta name (assoc (meta name) :private true)) decls))
+
+(defmacro defstruct-
+ "Same as defstruct but yields a private definition"
+ [name & decls]
+ (list* `defstruct (with-meta name (assoc (meta name) :private true)) decls))
+
+(defmacro defalias
+ "Defines an alias for a var: a new var with the same value and metadata
+ as another with the exception of :namespace, :name, :file, :line, and
+ optionally :doc which are those of new var."
+ ([name orig]
+ `(let [v# (def ~name ~orig)]
+ (. v# (setMeta (merge (meta #'~orig) (meta #'~name))))
+ v#))
+ ([name orig doc]
+ `(let [v# (def ~name ~orig)]
+ (. v# (setMeta (merge (meta #'~orig) (assoc (meta #'~name) :doc ~doc))))
+ v#)))
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))
diff --git a/src/clojure/contrib/fcase.clj b/src/clojure/contrib/fcase.clj
new file mode 100644
index 00000000..7e21b7c9
--- /dev/null
+++ b/src/clojure/contrib/fcase.clj
@@ -0,0 +1,92 @@
+;;; fcase.clj -- simple variants of "case" for Clojure
+
+;; by Stuart Sierra <mail@stuartsierra.com>
+;; April 7, 2008
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.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.
+
+
+;; This file defines a generic "case" macro called "fcase" which takes
+;; the equality-testing function as an argument. It also defines a
+;; traditional "case" macro that tests using "=" and variants that
+;; test for regular expressions and class membership.
+
+
+(ns clojure.contrib.fcase)
+
+
+(defmacro fcase
+ "Generic switch/case macro. 'fcase' is short for 'function case'.
+
+ The 'compare-fn' is a fn of two arguments.
+
+ The 'test-expr-clauses' are value-expression pairs without
+ surrounding parentheses, like in Clojure's 'cond'.
+
+ The 'case-value' is evaluated once and cached. Then, 'compare-fn'
+ is called once for each clause, with the clause's test value as its
+ first argument and 'case-value' as its second argument. If
+ 'compare-fn' returns logical true, the clause's expression is
+ evaluated and returned. If 'compare-fn' returns false/nil, we go to
+ the next test value.
+
+ If 'test-expr-clauses' contains an odd number of items, the last
+ item is the default expression evaluated if no case-value matches.
+ If there is no default expression and no case-value matches, fcase
+ returns nil.
+
+ See specific forms of this macro in 'case' and 're-case'.
+
+ The test expressions in 'fcase' are always evaluated linearly, in
+ order. For a large number of case expressions it may be more
+ efficient to use a hash lookup."
+ [compare-fn case-value &
+ test-expr-clauses]
+ (let [test-val-sym (gensym "test_val")
+ test-fn-sym (gensym "test_fn")
+ cond-loop (fn this [clauses]
+ (cond
+ (>= (count clauses) 2)
+ (list 'if (list test-fn-sym (first clauses) test-val-sym)
+ (second clauses)
+ (this (rest (rest clauses))))
+ (= (count clauses) 1) (first clauses)))]
+ (list 'let [test-val-sym case-value, test-fn-sym compare-fn]
+ (cond-loop test-expr-clauses))))
+
+(defmacro case
+ "Like cond, but test-value is compared against the value of each
+ test expression with =. If they are equal, executes the \"body\"
+ expression. Optional last expression is executed if none of the
+ test expressions match."
+ [test-value & clauses]
+ `(fcase = ~test-value ~@clauses))
+
+(defmacro re-case
+ "Like case, but the test expressions are regular expressions, tested
+ with re-find."
+ [test-value & clauses]
+ `(fcase re-find ~test-value ~@clauses))
+
+(defmacro instance-case
+ "Like case, but the test expressions are Java class names, tested with
+ 'instance?'."
+ [test-value & clauses]
+ `(fcase instance? ~test-value ~@clauses))
+
+(defn- in-case-test [test-seq case-value]
+ (some (fn [item] (= item case-value))
+ test-seq))
+
+(defmacro in-case
+ "Like case, but test expressions are sequences. The test expression
+ is true if any item in the sequence is equal (tested with '=') to
+ the test value."
+ [test-value & clauses]
+ `(fcase in-case-test ~test-value ~@clauses))
diff --git a/src/clojure/contrib/lazy_seqs.clj b/src/clojure/contrib/lazy_seqs.clj
new file mode 100644
index 00000000..5736e20f
--- /dev/null
+++ b/src/clojure/contrib/lazy_seqs.clj
@@ -0,0 +1,94 @@
+;; 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.
+;;
+;; lazy-seqs
+;;
+;; == Lazy sequences ==
+;;
+;; primes - based on the "naive" implemention described in [1] plus a
+;; small "wheel" which eliminates multiples of 2, 3, 5, and
+;; 7 from consideration by incrementing past them. Also inspired
+;; by code from Christophe Grand in [2].
+;;
+;; fibs - based on code from Rich Hickey at the Clojure wiki [3]
+;;
+;; powers-of-2 - all the powers of 2
+;;
+;; == Lazy sequence functions ==
+;;
+;; rotations - returns a lazy seq of all the rotations of a seq
+;;
+;; permutations - returns a lazy seq of all the permutations of a seq
+;;
+;; [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf
+;; [2] http://clj-me.blogspot.com/2008/06/primes.html
+;; [3] http://en.wikibooks.org/wiki/Clojure_Programming#Examples
+;;
+;; scgilardi (gmail)
+;; Created 07 June 2008
+
+(ns clojure.contrib.lazy-seqs
+ (:use clojure.contrib.def))
+
+(defvar primes
+ (lazy-cat [2 3 5 7]
+ (let [primes-from
+ (fn primes-from [n [f & r]]
+ (if (some #(zero? (rem n %))
+ (take-while #(<= (* % %) n) primes))
+ (recur (+ n f) r)
+ (lazy-cons n (primes-from (+ n f) r))))
+ wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2
+ 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6
+ 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])]
+ (primes-from 11 wheel)))
+ "A lazy sequence of all the prime numbers.")
+
+(defvar fibs
+ (lazy-cat [0 1]
+ (let [rest-fn
+ (fn rest-fn [a b]
+ (let [next (+ a b)]
+ (lazy-cons next (rest-fn b next))))]
+ (rest-fn 0 1)))
+ "A lazy sequence of all the fibonacci numbers.")
+
+(defvar powers-of-2
+ (lazy-cons 1 (map #(bit-shift-left % 1) powers-of-2))
+ "A lazy sequence of all the powers of 2")
+
+(defn rotations
+ "Returns a lazy seq of all rotations of a seq"
+ [x]
+ (if (seq x)
+ (map
+ (fn [n _]
+ (lazy-cat (drop n x) (take n x)))
+ (iterate inc 0) x)
+ (list nil)))
+
+(defn permutations
+ "Returns a lazy seq of all permutations of a seq"
+ [x]
+ (if (seq x)
+ (mapcat
+ (fn [[f & r]]
+ (map #(cons f %) (permutations r)))
+ (rotations x))
+ (list nil)))
+
+(defn combinations
+ "Returns a lazy seq of all combinations built of one item from each seq given.
+ See also (doc for)"
+ [& acs]
+ (let [step (fn step [head [s & cs :as acs]]
+ (if acs
+ (mapcat #(step (conj head %) cs) s)
+ (list head)))]
+ (when acs
+ (step [] acs))))
diff --git a/src/clojure/contrib/memoize.clj b/src/clojure/contrib/memoize.clj
new file mode 100644
index 00000000..558106c6
--- /dev/null
+++ b/src/clojure/contrib/memoize.clj
@@ -0,0 +1,31 @@
+;; 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.
+;;
+;; File: memoize.clj
+;;
+;; scgilardi (gmail)
+;; 02 June 2008
+;;
+;; Based on Common Lisp code from:
+;; http://asymmetrical-view.com/talks/lisp-presentation/lisp-presentation.pdf
+
+(ns clojure.contrib.memoize)
+
+(defn memoize
+ "Returns a memoized version of a referentially transparent function. The
+ memoized version of the function keeps a cache of the mapping from arguments
+ to results and, when calls with the same arguments are repeated often, has
+ higher performance at the expense of higher memory use."
+ [function]
+ (let [cache (ref {})]
+ (fn [& args]
+ (or (@cache args)
+ (let [result (apply function args)]
+ (dosync
+ (commute cache assoc args result))
+ result)))))
diff --git a/src/clojure/contrib/miglayout.clj b/src/clojure/contrib/miglayout.clj
new file mode 100644
index 00000000..3fc5971e
--- /dev/null
+++ b/src/clojure/contrib/miglayout.clj
@@ -0,0 +1,63 @@
+;; 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.
+;;
+;; clojure.contrib.miglayout
+;;
+;; Clojure support for the MiGLayout layout manager
+;; http://www.miglayout.com/
+;;
+;; Example:
+;;
+;; (require '[clojure.contrib.miglayout.test :as mlt])
+;; (doseq i (range 3) (mlt/run-test i))
+;;
+;; scgilardi (gmail)
+;; Created 5 October 2008
+
+(ns clojure.contrib.miglayout
+ (:import (java.awt Container Component)
+ (net.miginfocom.swing MigLayout))
+ (:use clojure.contrib.miglayout.internal))
+
+(defn miglayout
+ "Adds java.awt.Components to a java.awt.Container with constraints
+ formatted for the MiGLayout layout manager.
+
+ Arguments: container [item constraint*]*
+
+ - container: the container for the specified components, its layout
+ manager will be set to a new instance of MigLayout
+
+ - an inline series of items and constraints--each item may be followed
+ by zero or more constraints.
+
+ Item:
+
+ - An item is either a Component or one of the keywords :layout
+ :column or :row. Constraints for a keyword item affect the entire
+ layout.
+
+ Constraint: string, keyword, vector, or map
+
+ - A string specifies one or more constraints each with zero or more
+ arguments.
+ - A keyword specifies a single constraint without arguments
+ - A vector specifies a single constraint with one or more arguments
+ - A map specifies one or more constraints as keys, each mapped to a
+ single argument"
+ [#^Container container & args]
+ (let [{:keys [keyword-items components]}
+ (apply parse-item-constraints args)]
+ (.setLayout container
+ (MigLayout.
+ (:layout keyword-items)
+ (:column keyword-items)
+ (:row keyword-items)))
+ (doseq [[#^Component component constraints] components]
+ (.add container component constraints))
+ container))
diff --git a/src/clojure/contrib/miglayout/internal.clj b/src/clojure/contrib/miglayout/internal.clj
new file mode 100644
index 00000000..07391b77
--- /dev/null
+++ b/src/clojure/contrib/miglayout/internal.clj
@@ -0,0 +1,75 @@
+;; 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.
+;;
+;; clojure.contrib.miglayout.internal
+;;
+;; Internal functions for 'clojure.contrib.miglayout
+;;
+;; scgilardi (gmail)
+;; Created 13 October 2008
+
+(ns clojure.contrib.miglayout.internal
+ (:import (java.awt Component))
+ (:use (clojure.contrib except fcase)))
+
+(defn format-constraint
+ "Returns a vector of vectors representing one or more constraints
+ separated by commas. Constraints may be specified in Clojure using
+ strings, keywords, vectors, and/or maps."
+ [c]
+ [[", "]
+ (fcase #(%1 %2) c
+ string? [c]
+ keyword? [c]
+ vector? (interpose " " c)
+ map? (apply concat (interpose [", "] (map #(interpose " " %) c)))
+ (throwf IllegalArgumentException
+ "unrecognized constraint: %s (%s)" c (class c)))])
+
+(defn the-str
+ "Returns the string for x--its name if it's a keyword."
+ [x]
+ ((if (keyword? x) name str) x))
+
+(defn format-constraints
+ "Returns a string representing all the constraints for one keyword-item
+ or component formatted for miglayout."
+ [& constraints]
+ (apply str
+ (map the-str
+ (rest (reduce concat []
+ (mapcat format-constraint constraints))))))
+
+(defn component?
+ "Returns true if x is a java.awt.Component"
+ [x]
+ (instance? Component x))
+
+(defn constraint?
+ "Returns true if x is not a keyword-item or component"
+ [x]
+ (not
+ (or (component? x)
+ (#{:layout :column :row} x))))
+
+(defn parse-item-constraints
+ "Iterates over args and builds a map containing :keywords, a map of from
+ keyword-item to constraints string and :components, a vector of vectors
+ each associating a component with its constraints string. :components is
+ a vector because ordering of components matters."
+ [& args]
+ (loop [[item & args] args
+ item-constraints {:components [] :keyword-items {}}]
+ (if item
+ (let [[constraints args] (split-with constraint? args)]
+ (recur args
+ (update-in
+ item-constraints
+ [(if (component? item) :components :keyword-items)]
+ conj [item (apply format-constraints constraints)])))
+ item-constraints)))
diff --git a/src/clojure/contrib/miglayout/test.clj b/src/clojure/contrib/miglayout/test.clj
new file mode 100644
index 00000000..3ff7a97c
--- /dev/null
+++ b/src/clojure/contrib/miglayout/test.clj
@@ -0,0 +1,86 @@
+;; 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.
+;;
+;; clojure.contrib.miglayout.test
+;;
+;; Test/example for clojure.contrib.miglayout
+;;
+;; scgilardi (gmail)
+;; Created 5 October 2008
+
+(ns clojure.contrib.miglayout.test
+ (:import (javax.swing JButton JFrame JLabel JList JPanel
+ JScrollPane JTabbedPane JTextField JSeparator))
+ (:use clojure.contrib.miglayout))
+
+(def tests)
+
+(defn run-test
+ [index]
+ (doto (JFrame. (format "MigLayout Test %d" index))
+ (add ((tests index) (JPanel.)))
+ (pack)
+ (setVisible true)))
+
+(def tests [
+
+ (fn test0
+ [panel]
+ (miglayout panel
+ (JLabel. "Hello")
+ (JLabel. "World") {:gap :unrelated}
+ (JTextField. 10) :wrap
+ (JLabel. "Bonus!")
+ (JButton. "Bang it") {:wmin :button :grow :x :span 2} :center))
+
+ ;; test1 and test2 are based on code from
+ ;; http://www.devx.com/java/Article/38017/1954
+
+ ;; constraints as strings exclusively
+ (fn test1
+ [panel]
+ (miglayout panel
+ :column "[right]"
+ (JLabel. "General") "split, span"
+ (JSeparator.) "growx, wrap"
+ (JLabel. "Company") "gap 10"
+ (JTextField. "") "span, growx"
+ (JLabel. "Contact") "gap 10"
+ (JTextField. "") "span, growx, wrap"
+ (JLabel. "Propeller") "split, span, gaptop 10"
+ (JSeparator.) "growx, wrap, gaptop 10"
+ (JLabel. "PTI/kW") "gapx 10, gapy 15"
+ (JTextField. 10)
+ (JLabel. "Power/kW") "gap 10"
+ (JTextField. 10) "wrap"
+ (JLabel. "R/mm") "gap 10"
+ (JTextField. 10)
+ (JLabel. "D/mm") "gap 10"
+ (JTextField. 10)))
+
+ ;; the same constraints as strings, keywords, vectors, and maps
+ (fn test2
+ [panel]
+ (miglayout panel
+ :column "[right]"
+ (JLabel. "General") "split, span"
+ (JSeparator.) :growx :wrap
+ (JLabel. "Company") [:gap 10]
+ (JTextField. "") :span :growx
+ (JLabel. "Contact") [:gap 10]
+ (JTextField. "") :span :growx :wrap
+ (JLabel. "Propeller") :split :span [:gaptop 10]
+ (JSeparator.) :growx :wrap [:gaptop 10]
+ (JLabel. "PTI/kW") {:gapx 10 :gapy 15}
+ (JTextField. 10)
+ (JLabel. "Power/kW") [:gap 10]
+ (JTextField. 10) :wrap
+ (JLabel. "R/mm") [:gap 10]
+ (JTextField. 10)
+ (JLabel. "D/mm") [:gap 10]
+ (JTextField. 10)))])
diff --git a/src/clojure/contrib/ns_utils.clj b/src/clojure/contrib/ns_utils.clj
new file mode 100644
index 00000000..5a3d033c
--- /dev/null
+++ b/src/clojure/contrib/ns_utils.clj
@@ -0,0 +1,86 @@
+;; 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.
+;;
+;; ns-utils
+;;
+;; Namespace Utilities
+;;
+;; 'get-ns' returns the namespace named by a symbol or throws
+;; if the namespace does not exist
+;;
+;; 'ns-vars' returns a sorted seq of symbols naming public vars
+;; in a namespace
+;;
+;; 'print-dir' prints a sorted directory of public vars in a
+;; namespace
+;;
+;; 'print-docs' prints documentation for the public vars in a
+;; namespace
+;;
+;; Convenience
+;;
+;; 'vars' returns a sorted seq of symbols naming public vars
+;; in a namespace (macro)
+;;
+;; 'dir' prints a sorted directory of public vars in a
+;; namespace (macro)
+;;
+;; 'docs' prints documentation for the public vars in a
+;; namespace (macro)
+;;
+;; scgilardi (gmail)
+;; 23 April 2008
+
+(ns clojure.contrib.ns-utils
+ (:use clojure.contrib.except))
+
+;; Namespace Utilities
+
+(defn get-ns
+ "Returns the namespace named by ns-sym or throws if the
+ namespace does not exist"
+ [ns-sym]
+ (let [ns (find-ns ns-sym)]
+ (throw-if (not ns) "Unable to find namespace: %s" ns-sym)
+ ns))
+
+(defn ns-vars
+ "Returns a sorted seq of symbols naming public vars in
+ a namespace"
+ [ns]
+ (sort (map first (ns-publics ns))))
+
+(defn print-dir
+ "Prints a sorted directory of public vars in a namespace"
+ [ns]
+ (doseq [item (ns-vars ns)]
+ (println item)))
+
+(defn print-docs
+ "Prints documentation for the public vars in a namespace"
+ [ns]
+ (doseq [item (ns-vars ns)]
+ (print-doc (ns-resolve ns item))))
+
+;; Convenience
+
+(defmacro vars
+ "Returns a sorted seq of symbols naming public vars in
+ a namespace"
+ [nsname]
+ `(ns-vars (get-ns '~nsname)))
+
+(defmacro dir
+ "Prints a sorted directory of public vars in a namespace"
+ [nsname]
+ `(print-dir (get-ns '~nsname)))
+
+(defmacro docs
+ "Prints documentation for the public vars in a namespace"
+ [nsname]
+ `(print-docs (get-ns '~nsname)))
diff --git a/src/clojure/contrib/pred.clj b/src/clojure/contrib/pred.clj
new file mode 100644
index 00000000..9760ec0e
--- /dev/null
+++ b/src/clojure/contrib/pred.clj
@@ -0,0 +1,70 @@
+;; 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.
+;;
+;; pred.clj
+;;
+;; Some clojure predicates
+;;
+;; Items commented out below are defined in the clojure namespace
+;;
+;; scgilardi (gmail)
+;; 28 June 2008
+
+(ns clojure.contrib.pred)
+
+;; coll?
+;; list?
+;; map?
+;; set?
+
+(defn stack?
+ "Returns true if x implements IPersistentStack"
+ [x]
+ (instance? clojure.lang.IPersistentStack x))
+
+;; vector?
+
+(defn ref?
+ "Returns true if x implements IRef"
+ [x]
+ (instance? clojure.lang.IRef x))
+
+;; seq?
+;; var?
+
+(defn map-entry?
+ "Returns true if x is a MapEntry"
+ [x]
+ (instance? clojure.lang.MapEntry x))
+
+(defn atom?
+ "Returns true if x is not a collection"
+ [x]
+ (not (coll? x)))
+
+;; number?
+;; ratio?
+
+(defn range?
+ "Returns true if x is a Range"
+ [x]
+ (instance? clojure.lang.Range x))
+
+;; function? -> fn?
+
+(defmacro macro?
+ "Returns true if x is a function and the symbol of the
+ same name can be resolved and has its :macro metadata
+ set"
+ [x]
+ `(and (fn? ~x) (boolean (:macro ^#'~x))))
+
+;; integer?
+;; even?
+;; odd?
+;; empty?
diff --git a/src/clojure/contrib/sql.clj b/src/clojure/contrib/sql.clj
new file mode 100644
index 00000000..74608fff
--- /dev/null
+++ b/src/clojure/contrib/sql.clj
@@ -0,0 +1,138 @@
+;; 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.
+;;
+;; sql.clj
+;;
+;; A Clojure interface to sql databases via jdbc
+;;
+;; See clojure.contrib.sql.test for an example
+;;
+;; scgilardi (gmail)
+;; Created 2 April 2008
+
+(ns clojure.contrib.sql
+ (:use clojure.contrib.except
+ clojure.contrib.sql.internal))
+
+(defmacro with-connection
+ "Evaluates body in the context of a new connection to a database then
+ closes it. db-spec is a map containing string values for these required
+ keys:
+ :classname the jdbc driver class name
+ :subprotocol the jdbc subprotocol
+ :subname the jdbc subname
+ db-spec may contain additional key-value pairs that are passed along to
+ the driver as properties such as :user, :password, etc."
+ [db-spec & body]
+ `(do
+ (Class/forName (:classname ~db-spec))
+ (with-open [con#
+ (java.sql.DriverManager/getConnection
+ (format "jdbc:%s:%s" (:subprotocol ~db-spec) (:subname ~db-spec))
+ (properties (dissoc ~db-spec :classname :subprotocol :subname)))]
+ (binding [*db* (assoc *db* :connection con# :level 0)]
+ ~@body))))
+
+(defmacro transaction
+ "Evaluates body as a transaction on the open database connection. Updates
+ are committed together as a group after evaluating body or rolled back on
+ any uncaught exception. Any nested transactions will be absorbed into the
+ outermost transaction."
+ [& body]
+ `(let [con# (connection)
+ level# (:level *db*)]
+ (binding [*db* (assoc *db* :level (inc level#))]
+ (let [auto-commit# (.getAutoCommit con#)]
+ (when (zero? level#)
+ (.setAutoCommit con# false))
+ (try
+ (let [value# (do ~@body)]
+ (when (zero? level#)
+ (.commit con#))
+ value#)
+ (catch Exception e#
+ (.rollback con#)
+ (throw (Exception.
+ (format "transaction rolled back: %s"
+ (.getMessage e#)) e#)))
+ (finally
+ (when (zer