Added require/use/load-resources, contributed by Stephen C. Gilardi

enhanced ns macro to call these

1 files changed, 239 insertions, 35 deletions

diff --git a/src/clj/clojure/boot.clj b/src/clj/clojure/boot.clj
index 4a4d176a..6e3f878a 100644
--- a/src/clj/clojure/boot.clj
+++ b/src/clj/clojure/boot.clj
@@ -1388,9 +1388,6 @@
   "Evaluates the form data structure (not text!) and returns the result."
   [form] (. clojure.lang.Compiler (eval form)))
 
-;(defn defimports [& imports-maps]
-;  (def *imports* (apply merge imports-maps)))
-
 (defmacro doseq
   "Repeatedly executes body (presumably for side-effects) with
   binding-form bound to successive items from coll.  Does not retain
@@ -1478,7 +1475,8 @@
   "import-list => (package-symbol class-name-symbols*)
 
   For each name in class-name-symbols, adds a mapping from name to the
-  class named by package.name to the current namespace."  
+  class named by package.name to the current namespace. Use :imports in the ns 
+  macro in preference to calling this directly."  
   [& import-lists]
     (when import-lists
       (let [#^clojure.lang.Namespace ns *ns*
@@ -1488,13 +1486,6 @@
           (. ns (importClass c (. Class (forName (str pkg "." c)))))) )
       (apply import (rest import-lists))))
 
-(defmacro imports
-  "import-list => (package-name class-names*)
-
-  For each (unevaluated) name in class-names, adds a mapping from name to the
-  class named by package-name.name to the current namespace."
-  [& import-lists] `(import ~@(map #(list 'quote %) import-lists)))
-
 (defn into-array
   "Returns an array of the type of the first element in coll,
   containing the contents of coll, which must be of a compatible
@@ -1986,7 +1977,7 @@
   something else in the current namespace. Filters can be used to
   select a subset, via inclusion or exclusion, or to provide a mapping
   to a symbol different from the var's name, in order to prevent
-  clashes."
+  clashes. Use :uses in the ns macro in preference to calling this directly."
   [ns-sym & filters]
     (let [ns (or (find-ns ns-sym) (throw (new Exception (str "No namespace: " ns-sym))))
           fs (apply hash-map filters)
@@ -2001,23 +1992,6 @@
               (throw (new java.lang.IllegalAccessError (str sym " is not public"))))
             (. *ns* (refer (or (rename sym) sym) v)))))))
 
-(defmacro refers 
-  "refers to all public vars of ns, subject to filters.
-  filters can include at most one each of:
-
-  :exclude list-of-names
-  :only list-of-names
-  :rename map-of-fromname-toname
-
-  For each public interned var in the namespace named by the symbol,
-  adds a mapping from the name of the var to the var to the current
-  namespace.  Throws an exception if name is already mapped to
-  something else in the current namespace. Filters can be used to
-  select a subset, via inclusion or exclusion, or to provide a mapping
-  to a symbol different from the var's name, in order to prevent
-  clashes."
-  [ns-name & filters] `(refer '~ns-name ~@(map #(list 'quote %) filters)))
-
 (defn ns-refers
   "Returns a map of the refer mappings for the namespace."
   [#^clojure.lang.Namespace ns]
@@ -2978,12 +2952,26 @@
 
 (defmacro ns
   "Sets *ns* to the namespace named by name (unevaluated), creating it if needed. 
-  If the ns didn't already exist, refers the clojure namespace"
-  [name]
-  `(let [existed# (clojure.lang.Namespace/find '~name)]
-     (in-ns '~name)
-     (when-not existed#
-       (clojure/refer '~'clojure))))
+  If the ns didn't already exist, refers the clojure namespace. references can be zero or more of:
+  (:requires ...) (:uses ...) (:imports ...) with the syntax of require/use/import respectively, 
+  except the arguments are unevaluated and need not be quoted. Use of ns is preferred to 
+  individual calls to in-ns/require/use/import:
+
+  (ns foo
+    (:requires (clojure.contrib sql sql.tests))
+    (:uses (my.lib this that))
+    (:imports (java.util Date Timer Random)
+              (java.sql Connection Statement)))"
+  [name & references]
+  (let [process-reference 
+        (fn [[kname & args]]
+          `(~(symbol (subs (clojure/name kname) 0 (dec (count (clojure/name kname))))) 
+            ~@(map #(list 'quote %) args)))]
+    `(let [existed# (clojure.lang.Namespace/find '~name)]
+       (in-ns '~name)
+       (when-not existed#
+         (clojure/refer '~'clojure))
+     ~@(map process-reference references))))
 
 (defmacro defonce 
   "defs name to have the root value of the expr iff the named var has no root value, 
@@ -2992,3 +2980,219 @@
   `(let [v# (def ~name)]
      (when-not (.hasRoot v#)
        (def ~name ~expr))))
+
+;;;;;;;;;;; require/use/load-resources, contributed by Stephen C. Gilardi ;;;;;;;;;;;;;;;;;;
+
+(defonce
+  #^{:private true 
+     :doc "A ref to a sorted set of symbols representing loaded libs"}
+  *loaded-libs* (ref (sorted-set)))
+
+(defonce
+  #^{:private true :doc
+     "True while a verbose load is pending"}
+  *loading-verbosely* false)
+
+(defn- throw-if
+  "Throws an exception with a message if pred is true"
+  [pred fmt & args]
+  (when pred
+    (let [message (apply format fmt args)
+          exception (Exception. message)
+          raw-trace (.getStackTrace exception)
+          boring? #(not= (.getMethodName %) "doInvoke")
+          trace (into-array (drop 2 (drop-while boring? raw-trace)))]
+      (.setStackTrace exception trace)
+      (throw exception))))
+
+(defn- libspec?
+  "Returns true if x is a libspec"
+  [x]
+  (or (symbol? x)
+      (and (vector? x)
+           (or
+            (nil? (second x))
+            (keyword? (second x))))))
+
+(defn- prependss
+  "Prepends a symbol or a seq to coll"
+  [x coll]
+  (if (symbol? x)
+    (cons x coll)
+    (concat x coll)))
+
+(defn- root-directory
+  "Returns the root directory path for a lib"
+  [lib]
+  (str \/
+       (.. (name lib)
+           (replace \- \_)
+           (replace \. \/))))
+
+(defn- root-resource
+  "Returns the root resource path for a lib"
+  [lib]
+  (let [d (root-directory lib)
+        i (inc (.lastIndexOf d (int \/)))
+        leaf (.substring d i)]
+    (str d \/ leaf ".clj")))
+
+(def load-resources)
+
+(defn- load-one
+  "Loads a lib given its name. If need-ns, ensures that the associated
+  namespace exists after loading. If require, records the load so any
+  duplicate loads can be skipped."
+  [lib need-ns require]
+  (load-resources (root-resource lib))
+  (throw-if (and need-ns (not (find-ns lib)))
+            "namespace '%s' not found after loading '%s'"
+            lib (root-resource lib))
+  (when require
+    (dosync
+     (commute *loaded-libs* conj lib))))
+
+(defn- load-all
+  "Loads a lib given its name and forces a load of any libs it directly or
+  indirectly loads. If need-ns, ensures that the associated namespace
+  exists after loading. If require, records the load so any duplicate loads
+  can be skipped."
+  [lib need-ns require]
+  (dosync
+   (commute *loaded-libs* #(reduce conj %1 %2)
+            (binding [*loaded-libs* (ref (sorted-set))]
+              (load-one lib need-ns require)
+              @*loaded-libs*))))
+
+(defn- load-lib
+  "Loads a lib with options"
+  [prefix lib & options]
+  (throw-if (and prefix (pos? (.indexOf (name lib) (int \.))))
+            "lib names inside prefix lists must not contain periods")
+  (let [lib (if prefix (symbol (str prefix \. lib)) lib)
+        opts (apply hash-map options)
+        {:keys [as reload reload-all require use verbose]} opts
+        loaded (contains? @*loaded-libs* lib)
+        load (cond reload-all
+                   load-all
+                   (or reload (not require) (not loaded))
+                   load-one)
+        need-ns (or as use)
+        filter-opts (select-keys opts '(:exclude :only :rename))]
+    (binding [*loading-verbosely* (or *loading-verbosely* verbose)]
+      (if load
+        (load lib need-ns require)
+        (throw-if (and need-ns (not (find-ns lib)))
+                  "namespace '%s' not found" lib))
+      (when (and need-ns *loading-verbosely*)
+        (printf "(clojure/in-ns '%s)\n" (ns-name *ns*)))
+      (when as
+        (when *loading-verbosely*
+          (printf "(clojure/alias '%s '%s)\n" as lib))
+        (alias as lib))
+      (when use
+        (when *loading-verbosely*
+          (printf "(clojure/refer '%s" lib)
+          (doseq opt filter-opts
+            (printf " %s '%s" (key opt) (print-str (val opt))))
+          (printf ")\n"))
+        (apply refer lib (mapcat seq filter-opts))))))
+
+(defn- load-libs
+  "Loads libs, interpreting libspecs, prefix lists, and flags for
+  forwarding to load-lib"
+  [& args]
+  (let [flags (filter keyword? args)
+        opts (interleave flags (repeat true))
+        args (filter (complement keyword?) args)]
+    (doseq arg args
+      (if (libspec? arg)
+        (apply load-lib nil (prependss arg opts))
+        (let [[prefix & args] arg]
+          (throw-if (nil? prefix) "prefix cannot be nil")
+          (doseq arg args
+            (apply load-lib prefix (prependss arg opts))))))))
+
+;; Public
+
+(defn require
+  "Loads libs, skipping any that are already loaded. Each argument is
+  either a libspec that identifies a lib, a prefix list that identifies
+  multiple libs whose names share a common prefix, or a flag that modifies
+  how all the identified libs are loaded. Use :requires in the ns macro 
+  in preference to calling this directly.
+
+  Libs
+
+  A 'lib' is a named set of resources in classpath whose contents define a
+  library of Clojure code. Lib names are symbols and each lib is associated
+  with a Clojure namespace and a Java package that share its name. A lib's
+  name also locates its root directory within classpath using Java's
+  package name to classpath-relative path mapping. All resources in a lib
+  should be contained in the directory structure under its root directory.
+  All definitions a lib makes should be in its associated namespace.
+
+  'require loads a lib by loading its root resource. The root resource path
+  is derived from the root directory path by repeating its last component
+  and appending '.clj'. For example, the lib 'x.y.z has root directory
+  <classpath>/x/y/z; root resource <classpath>/x/y/z/z.clj. The root
+  resource should contain code to create the lib's namespace and load any
+  additional lib resources.
+
+  Libspecs
+
+  A libspec is a lib name or a vector containing a lib name followed by
+  options expressed as sequential keywords and arguments.
+
+  Recognized options: :as
+  :as takes a symbol as its argument and makes that symbol an alias to the
+    lib's namespace in the current namespace.
+
+  Prefix Lists
+
+  It's common for Clojure code to depend on several libs whose names have
+  the same prefix. When specifying libs, prefix lists can be used to reduce
+  repetition. A prefix list contains the shared prefix followed by libspecs
+  with the shared prefix removed from the lib names. After removing the
+  prefix, the names that remain must not contain any periods.
+
+  Flags
+
+  A flag is a keyword.
+  Recognized flags: :reload, :reload-all, :verbose
+  :reload forces loading of all the identified libs even if they are
+    already loaded
+  :reload-all implies :reload and also forces loading of all libs that the
+    identified libs directly or indirectly load via require or use
+  :verbose triggers printing information about calls to load-resources,
+    alias, and refer"
+  [& args]
+  (apply load-libs :require args))
+
+(defn use
+  "Like 'require, but also refers to each lib's namespace using
+  clojure/refer. Use :uses in the ns macro in preference to calling
+  this directly.
+
+  'use accepts additional options in libspecs: :exclude, :only, :rename.
+  The arguments and semantics for :exclude, :only, and :rename are the same
+  as those documented for clojure/refer."
+  [& args] (apply load-libs :require :use args))
+
+(defn loaded-libs
+  "Returns a sorted set of symbols naming the currently loaded libs"
+  [] @*loaded-libs*)
+
+(defn load-resources
+  "Loads Clojure code from resources in classpath. A path is interpreted as
+  classpath-relative if it begins with a slash or relative to the root
+  directory for the current namespace otherwise."
+  [& paths]
+  (doseq path paths
+    (let [path (if (.startsWith path "/")
+                 path
+                 (str (root-directory (ns-name *ns*)) \/ path))]
+      (when *loading-verbosely*
+        (printf "(clojure/load-resources \"%s\")\n" path)
+        (flush))
+      (.loadResourceScript clojure.lang.RT (.substring path 1)))))