def: new utility function name-with-attributes for use in var-defining macros

1 files changed, 26 insertions, 0 deletions

diff --git a/src/clojure/contrib/def.clj b/src/clojure/contrib/def.clj
index aff4a9d3..9310d367 100644
--- a/src/clojure/contrib/def.clj
+++ b/src/clojure/contrib/def.clj
@@ -85,3 +85,29 @@
      (def ~sym ~init)
      (alter-meta! (var ~sym) assoc :tag (class ~sym))
      (var ~sym)))
+
+; name-with-attributes by Konrad Hinsen:
+(defn name-with-attributes
+  "To be used in macro definitions.
+   Handles optional docstrings and attribute maps for a name to be defined
+   in a list of macro arguments. If the first macro argument is a string,
+   it is added as a docstring to name and removed from the macro argument
+   list. If afterwards the first macro argument is a map, its entries are
+   added to the name's metadata map and the map is removed from the
+   macro argument list. The return value is a vector containing the name
+   with its extended metadata map and the list of unprocessed macro
+   arguments."
+  [name macro-args]
+  (let [[docstring macro-args] (if (string? (first macro-args))
+				 [(first macro-args) (next macro-args)]
+				 [nil macro-args])
+	[attr macro-args]      (if (map? (first macro-args))
+				 [(first macro-args) (next macro-args)]
+				 [{} macro-args])
+	attr                   (if docstring
+				 (assoc attr :doc docstring)
+				 attr)
+	attr                   (if (meta name)
+				 (conj (meta name) attr)
+				 attr)]
+    [(with-meta name attr) macro-args]))