Merge setfork branch.

This commit is contained in:
Phil Hagelberg 2009-12-22 14:42:07 -08:00
commit 4fdad15915

View file

@ -6,6 +6,7 @@
[leiningen.deps :only [deps]]) [leiningen.deps :only [deps]])
(:refer-clojure :exclude [compile]) (:refer-clojure :exclude [compile])
(:import org.apache.tools.ant.taskdefs.Java (:import org.apache.tools.ant.taskdefs.Java
java.lang.management.ManagementFactory
(org.apache.tools.ant.types Environment$Variable Path))) (org.apache.tools.ant.types Environment$Variable Path)))
(defn namespaces-to-compile (defn namespaces-to-compile
@ -28,6 +29,53 @@
(filter #(.endsWith (.getName %) ".jar") (filter #(.endsWith (.getName %) ".jar")
(file-seq (file (:library-path project))))) (file-seq (file (:library-path project)))))
(defn get-by-pattern
"Gets a value from map m, but uses the keys as regex patterns,
trying to match against k instead of doing an exact match."
[m k]
(m (first (drop-while #(nil? (re-find (re-pattern %) k))
(keys m)))))
(def native-names
{"Mac OS X" :macosx
"Windows" :windows
"Linux" :linux
"SunOS" :solaris
"amd64" :x86_64
"x86_64" :x86_64
"x86" :x86
"i386" :x86
"arm" :arm
"sparc" :sparc})
(defn get-os
"Returns a keyword naming the host OS."
[]
(get-by-pattern native-names (System/getProperty "os.name")))
(defn get-arch
"Returns a keyword naming the host architecture"
[]
(get-by-pattern native-names (System/getProperty "os.arch")))
(defn find-native-lib-path
"Returns a File representing the directory where native libs for the
current platform are located."
[project]
(let [osdir (name (get-os))
archdir (name (get-arch))
f (file "native" osdir archdir)]
(if (.exists f)
f
nil)))
(defn get-jvm-args
"Returns a seq of strings with the arguments sent to this jvm instance."
[]
(-> (ManagementFactory/getRuntimeMXBean)
(.getInputArguments)
(seq)))
(defn make-path (defn make-path
"Constructs an ant Path object from Files and strings." "Constructs an ant Path object from Files and strings."
[& paths] [& paths]
@ -42,11 +90,21 @@
with the java task right before executing if you need to customize any of its with the java task right before executing if you need to customize any of its
properties (classpath, library-path, etc)." properties (classpath, library-path, etc)."
[project form & [handler]] [project form & [handler]]
(let [java (Java.)] (let [java (Java.)
native-path (or (:native-path project)
(find-native-lib-path project))]
(.setProject java lancet/ant-project) (.setProject java lancet/ant-project)
(.addSysproperty java (doto (Environment$Variable.) (.addSysproperty java (doto (Environment$Variable.)
(.setKey "clojure.compile.path") (.setKey "clojure.compile.path")
(.setValue (:compile-path project)))) (.setValue (:compile-path project))))
(when native-path
(.addSysproperty java (doto (Environment$Variable.)
(.setKey "java.library.path")
(.setValue (cond
(= java.io.File (class native-path))
(.getAbsolutePath native-path)
(fn? native-path) (native-path)
:default native-path)))))
(.setClasspath java (apply make-path (.setClasspath java (apply make-path
(:source-path project) (:source-path project)
(:test-path project) (:test-path project)
@ -54,6 +112,10 @@
(:resources-path project) (:resources-path project)
(find-lib-jars project))) (find-lib-jars project)))
(.setFailonerror java true) (.setFailonerror java true)
(when (or (= :macosx (get-os)) native-path)
(.setFork java true)
(doseq [arg (get-jvm-args)]
(.setValue (.createJvmarg java) arg)))
(.setClassname java "clojure.main") (.setClassname java "clojure.main")
(.setValue (.createArg java) "-e") (.setValue (.createArg java) "-e")
(.setValue (.createArg java) (prn-str form)) (.setValue (.createArg java) (prn-str form))